home *** CD-ROM | disk | FTP | other *** search
/ The Datafile PD-CD 3 / PDCD_3.iso / pocketbk / utilsr / table / TABLE.OPL next >
Text File  |  1993-12-30  |  2KB  |  83 lines
  1. REM Table v0.3
  2. REM by Roger Burton-West <ubte30e@ucl.ac.uk>
  3. REM copy freely and of your own will
  4.  
  5. PROC table:
  6.     local x%,y%,dy%,f%,s$(130),h%,xh%,i%(32),w%,k%
  7.     f%=7
  8.     s$="rom::\opd\*.fon"
  9.     dINIT "Choose font"
  10.     dCHOICE f%,"Font","S3 normal,S3 bold,S3 digit,Mono 8x8,Roman 8,Roman 11,Roman 13,Roman 16,Swiss 8,Swiss 11,Swiss 13,Swiss 16,Mono 6x6,Custom"
  11.     dFILE s$,"Custom font",8
  12.     if dialog=0
  13.         return
  14.     endif
  15.     busy "Working"+chr$(1),1
  16.     if f%=14
  17.         f%=gLOADFONT(s$)
  18.     endif
  19.     gFONT f%
  20.     gINFO i%()
  21.     gAT 0,7
  22.     gFONT 5
  23.     gPRINT peek$(addr(i%(9)))
  24.     h%=max(i%(4)+i%(5)+2,15)
  25.     xh%=h%*(int(i%(2)/30)-int(i%(1)/30)+1)
  26.     w%=gCREATE(0,0,480,xh%,0,0)
  27.     gUPDATE OFF
  28.     x%=0
  29.     dy%=0
  30.     do
  31.         gUSE 1
  32.         gFONT 5
  33.         gAT x%*14+60+7-gTWIDTH(gen$(x%,2))/2,11
  34.         gPRINT gen$(x%,2)
  35.         y%=int(i%(1)/30)
  36.         dy%=0
  37.         gUSE w%
  38.         gFONT f%
  39.         do
  40.             if x%=0
  41.                 gFONT 5
  42.                 gAT 40,(dy%+1)*h%-h%/2+4
  43.                 gPRINT 30*y%
  44.                 gFONT f%
  45.             endif
  46.             if x%+30*y%>=i%(1)
  47.                 gAT x%*14+60+7-gTWIDTH(chr$(x%+30*y%))/2,(dy%+1)*h%-i%(4)
  48.                 gPRINT chr$(x%+30*y%)
  49.             endif
  50.             y%=y%+1
  51.             dy%=dy%+1
  52.         until dy%=9 or x%+30*y%>i%(2)
  53.         x%=x%+1
  54.     until x%=30
  55.     busy off
  56.     gUPDATE ON
  57.     gUSE 1
  58.     y%=0
  59.     do
  60.         gUPDATE OFF
  61.         gAT 0,12
  62.         gCOPY w%,0,y%,480,min(xh%-y%,148),3
  63.         gUPDATE ON
  64.         gUPDATE
  65.         k%=get
  66.         if xh%>148
  67.             if k%=257
  68.                 y%=min(y%+h%,xh%-148)
  69.             elseif k%=256
  70.                 y%=max(y%-h%,0)
  71.             elseif k%=260
  72.                 y%=0
  73.             elseif k%=261
  74.                 y%=xh%-148
  75.             endif
  76.         endif
  77.     until k%<256
  78.     if f%>13
  79.         gUNLOADFONT f%
  80.     endif
  81.     gCLOSE w%
  82. ENDP
  83.