home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format 67 / af067a.adf / ACCESS.DMS / ACCESS.adf / Font8x8_Editor.AMOS / Font8x8_Editor.amosSourceCode
AMOS Source Code  |  1993-03-16  |  5KB  |  162 lines
  1. '*************************** 
  2. '*    AMOS Professional    * 
  3. '*                         * 
  4. '*       Font Editor       * 
  5. '*                         * 
  6. '* (c) Europress Software  * 
  7. '*                         * 
  8. '*     Ronnie Simpson      * 
  9. '*************************** 
  10. '
  11. Palette $0,$BB,$66,$33,$FF0,$B40,$FF0,$F70,$F10,$80F,$F07,$99,$840,$270,$33F,$FFF
  12. Flash Off : Curs Off : Cls 1 : Paper 1
  13. Reserve As Work 9,2048
  14. Reserve Zone 327
  15. Dim DX(256),DY(256),GX(64),GY(64),V(7)
  16. Global DX(),DY(),GX(),GY(),V(),L
  17. '
  18. '
  19. INIT
  20. Do 
  21.    M=Mouse Zone
  22.    If Mouse Key and M<257 and M>0
  23.       DISPLAY_TO_GRID[M-1] : DISPLAY_NEW
  24.    End If 
  25.    If Mouse Key and M>256 and M<321
  26.       CHANGEGRID[M-256]
  27.    End If 
  28.    If Mouse Key and M=322 Then STORE
  29.    If Mouse Key and M=323 Then SFONT
  30.    If Mouse Key and M=324 Then LFONT
  31.    If Mouse Key and M=325 Then Edit 
  32.    If Mouse Key and M=326 Then CLEAR_GRID : DISPLAY_NEW : NEW_GRID
  33.    If Mouse Key and M=327 Then SET_GRID : DISPLAY_NEW : NEW_GRID
  34. Loop 
  35. '
  36. '
  37. Procedure INIT
  38.    Set Paint 1 : Ink 14 : Box 0,0 To 319,199
  39.    Y=3 : Ink 0,,11
  40.    For L=0 To 15 : X=4
  41.       For C=1 To 16 : N=L*16+C
  42.          Bar X,Y To X+11,Y+11 : DX(N)=X : DY(N)=Y : Set Zone N,X,Y To X+11,Y+11
  43.          Add X,12
  44.       Next 
  45.       Add Y,12
  46.    Next 
  47.    Change Mouse 2
  48.    Y=3 : Ink 3,,8
  49.    For L=0 To 7 : X=211
  50.       For C=1 To 8 : N=L*8+C
  51.          Bar X,Y To X+11,Y+11 : GX(N)=X : GY(N)=Y : Set Zone N+256,X,Y To X+11,Y+11
  52.          Add X,12
  53.       Next 
  54.       Add Y,12
  55.    Next 
  56.    Change Mouse 2
  57.    Pen 2 : Ink 2 : Locate 27,14 : Print "CLEAR  SET" : Box 211,107 To 307,122 : Draw 264,107 To 264,122
  58.    Set Zone 326,211,107 To 263,122 : Set Zone 327,265,107 To 307,122
  59.    Pen 5 : Ink 5 : Locate 27,16 : Print "<< STORE" : Box 211,124 To 307,138 : Set Zone 322,211,124 To 307,138
  60.    Pen 14 : Ink 14 : Locate 28,18 : Print "SAVE FONT" : Box 211,140 To 307,154 : Set Zone 323,211,140 To 307,154
  61.    Pen 13 : Ink 13 : Locate 28,20 : Print "LOAD FONT" : Box 211,156 To 307,170 : Set Zone 324,211,156 To 307,170
  62.    Pen 12 : Ink 12 : Locate 31,22 : Print "QUIT" : Box 211,172 To 307,186 : Set Zone 325,211,172 To 307,186
  63.    Ink 3,,6 : Bar 286,125 To 297,136
  64.    L=1
  65. End Proc
  66. Procedure DISPLAY[X]
  67.    S=Start(9)+(X*8)
  68.   CP=(127)*40+(288/8)
  69.    For C=0 To 7
  70.       P=Peek(S+C)
  71.       Poke Phybase(0)+CP+C*40,P
  72.       Poke Phybase(1)+CP+C*40,P
  73.       Poke Phybase(2)+CP+C*40,P
  74.       Poke Phybase(3)+CP+C*40,P
  75.    Next 
  76.  Screen Copy 0,288,127,296,135 To 0,DX(X+1)+2,DY(X+1)+2
  77. End Proc
  78. Procedure DISPLAY_TO_GRID[X]
  79.    Ink 11 : Box DX(L+1),DY(L+1) To DX(L+1)+11,DY(L+1)+11
  80.    Ink 6 : Box DX(X+1),DY(X+1) To DX(X+1)+11,DY(X+1)+11 : L=X
  81.    Q=1
  82.    S=Start(9)+(X*8)
  83.    For C=0 To 7
  84.       P=Peek(S+C) : V(C)=P
  85.       For A=7 To 0 Step -1
  86.          If Btst(A,P)
  87.             Ink 6,,8 : Bar GX(Q),GY(Q) To GX(Q)+12,GY(Q)+12
  88.          Else 
  89.             Ink 3,,8 : Bar GX(Q),GY(Q) To GX(Q)+12,GY(Q)+12
  90.          End If 
  91.          Inc Q
  92.       Next 
  93.    Next 
  94. End Proc
  95. Procedure DISPLAY_NEW
  96.    For C=0 To 7
  97.    CP=(127)*40+(288/8)
  98.       P=V(C)
  99.       Poke Phybase(0)+CP+C*40,P
  100.       Poke Phybase(1)+CP+C*40,P
  101.       Poke Phybase(2)+CP+C*40,P
  102.       Poke Phybase(3)+CP+C*40,P
  103.    Next 
  104.    Shoot 
  105. End Proc
  106. Procedure CHANGEGRID[X]
  107.    BIT=(X-1) mod 8 : LINE=(X-1)/8 : BIT=7-BIT
  108.    If Point(GX(X)+2,GY(X)+2)=6
  109.       Ink 3,,8 : Bar GX(X),GY(X) To GX(X)+12,GY(X)+12 : Bclr BIT,V(LINE)
  110.    Else 
  111.       Ink 6,,8 : Bar GX(X),GY(X) To GX(X)+12,GY(X)+12 : Bset BIT,V(LINE)
  112.    End If 
  113.    Repeat : Until Mouse Key=0
  114.    DISPLAY_NEW
  115. End Proc
  116. Procedure STORE
  117.    S=Start(9)+(L*8)
  118.    For C=0 To 7
  119.       Poke S+C,V(C)
  120.    Next 
  121.    DISPLAY[L]
  122.    Bell 70
  123. End Proc
  124. Procedure LFONT
  125.    Ink 2,,5 : For N=1 To 256 : Bar DX(N)+2,DY(N)+2 To DX(N)+9,DY(N)+9 : Next 
  126.    F$=Fsel$("*.font","","Load AMOS default font","or a previously edited font")
  127.    If F$>""
  128.       Bload F$,9
  129.       For N=0 To 255 : DISPLAY[N] : Next 
  130.       DISPLAY_TO_GRID[L] : DISPLAY_NEW
  131.    End If 
  132. End Proc
  133. Procedure SFONT
  134.    F$=Fsel$("*.font","","Save edited font","Have you got a copy of the default ?")
  135.    If F$>"" Then Bsave F$,Start(9) To Start(9)+2048
  136. End Proc
  137. Procedure CLEAR_GRID
  138.    For A=0 To 7
  139.       V(A)=0
  140.    Next 
  141.    Bell 30
  142. End Proc
  143. Procedure SET_GRID
  144.    For A=0 To 7
  145.       V(A)=$FFF
  146.    Next 
  147.    Bell 30
  148. End Proc
  149. Procedure NEW_GRID
  150.    Q=1
  151.    For C=0 To 7
  152.       For A=7 To 0 Step -1
  153.          P=V(C)
  154.          If Btst(A,P)
  155.             Ink 6,,8 : Bar GX(Q),GY(Q) To GX(Q)+12,GY(Q)+12
  156.          Else 
  157.             Ink 3,,8 : Bar GX(Q),GY(Q) To GX(Q)+12,GY(Q)+12
  158.          End If 
  159.          Inc Q
  160.       Next 
  161.    Next 
  162. End Proc