! (Gimms-based) symbol drawing routines

constreal defaultscale=0.12

include "inc:util.imp"
include "inc:region.imp"
include "inc:level1.imp"

recordformat charheader(byte xbias,xmax,ybias,ymax,half data)
recordformat gimmsheader(integer fontlength,gimm,number,*,*,*,*,
   half scale,byte xx,yy,halfarray start(0:127))
constinteger penup=1<<15,lastvector=1<<7

ownrecord(gimmsheader)name header==nil
ownrecord(charheader)name ch
ownbytename chdata
owninteger xmax,ymax
ownreal rawfactor,factor

routine setup
integer filetoken,filesize,filepos=0,i
  header == new(header)
  accessfile("DOC:Gimms.Bin",0,filetoken,filesize)
  cycle
    readregion(filetoken,filepos,sizeof(header),byte(addr(header)))
    filepos = filepos+header_fontlength
    signal 15,,,"GIMMS file corrupt" unless header_gimm='GIMM'
  repeatuntil header_number='0005'
  filepos = filepos-header_fontlength+sizeof(header)
  i = header_fontlength-sizeof(header)
  chdata == byte(heapget(i))
  readregion(filetoken,filepos,i,chdata)
  deaccessfile(filetoken)
  xmax = 0; ymax = 0
  for i = 0,1,127 cycle
    continueif header_start(i)=0
    ch == record(addr(chdata[header_start(i)-256]))
    xmax = ch_xmax if ch_xmax>xmax
    ymax = ch_ymax if ch_ymax>ymax
  repeat
  rawfactor = 511/ymax; factor = rawfactor*defaultscale
end

externalroutine setscale(real r)
  setup if header==nil
  factor = rawfactor*r
end

externalroutine sizesymbol(integer i,integername n,s,e,w)
integer xpos,ypos,x,y
halfname d
  setup if header==nil
  n = 0; s = 0; e = 0; w = 0
  returnif header_start(i)=0
  ch == record(addr(chdata[header_start(i)-256])); d == ch_data
  w = int(ch_xbias*factor); s = int(ch_ybias*factor)
  e = int(ch_xmax*factor)-w; n = int(ch_ymax*factor)-s
end

externalroutine drawsymbol(integer i,xbase,ybase)
integer xpos,ypos,x,y
halfname d
  setup if header==nil
  returnif header_start(i)=0
  ch == record(addr(chdata[header_start(i)-256])); d == ch_data
  x = int(ch_xbias*factor); y = int(ch_ybias*factor)
  xbase = xbase-x; ybase = ybase-y
  xpos = 0; ypos = 0
  cycle
    x = int((d>>8&127)*factor)
    y = int((d&127)*factor)
    if d&penup#0 start
      xpos = x; ypos = y
    else
      line(xpos+xbase,ypos+ybase,x+xbase,y+ybase); xpos = x; ypos = y
    finish
    exitif d&lastvector#0
    d == d[1]
  repeat
end