home *** CD-ROM | disk | FTP | other *** search
/ AMOS PD CD / amospdcd.iso / sourcecode / routines / fontx.amos / fontx.amosSourceCode < prev    next >
AMOS Source Code  |  1992-10-04  |  11KB  |  478 lines
  1. ' ---------------------------------  
  2. ' -                               -  
  3. ' -   FontX 8*8 Font Editor V1.1  -    
  4. ' -                               -  
  5. ' -   By Neil Wright ï¿½ 1993       -  
  6. ' -                               -
  7. ' -   This version is             -
  8. ' -   Freeware                    -  
  9. ' -                               -
  10. ' -                               -
  11. ' ---------------------------------  
  12. '
  13. ' ---------------------------------------------------------  
  14. ' -                                                       -
  15. ' - Shortcuts:-  l = load font                            -
  16. ' -              s = save font                            -
  17. ' -              q = quit                                 -
  18. ' -              c = clear character set                  -
  19. ' -              p = put character into set               -
  20. ' -              g = get character from set               -
  21. ' -              f = fill edit window                     -
  22. ' -              e = clear edit window                    -      
  23. ' -              i = invert character                     -
  24. ' -              x = mirror character on x-axis           -
  25. ' -              y = mirror character on y-axis           -
  26. ' -                                                       -
  27. ' ---------------------------------------------------------
  28. '
  29. ' Consult the help file for instructions 
  30. '
  31. ' Also consult the Routines directory for some useful text routines  
  32. ' for you to use and abuse.
  33. '
  34. Change Mouse 3
  35. Flash Off : Curs Off : Cls 0
  36. Unpack 6 To 0
  37. Erase 11
  38. Reserve As Work 11,2048
  39. Reserve Zone 332
  40. '
  41. Dim CHARACTER_SET_X(256),CHARACTER_SET_Y(256)
  42. Dim CHARACTER_X(64),CHARACTER_Y(64)
  43. Dim _VALUE(7),X(64),JON(64)
  44. Global CHARACTER_SET_X(),X(),CHARACTER_SET_Y()
  45. Global CHARACTER_Y(),CHARACTER_X(),_VALUE(),L,CIA,JON(),STCURS
  46. Change Mouse 3
  47. '
  48. Rem *** Set character set zones ***
  49. '
  50. Y=21
  51. Ink 2
  52. For L=0 To 15 : X=15
  53.    For C=1 To 16 : N=L*16+C
  54.       CHARACTER_SET_X(N)=X : CHARACTER_SET_Y(N)=Y
  55.       Set Zone N,X,Y To X+11,Y+11
  56.       Add X,11
  57.    Next 
  58.    Add Y,11
  59. Next 
  60. '
  61. Y=21
  62. For L=0 To 7 : X=211
  63.    For C=1 To 8 : N=L*8+C
  64.       CHARACTER_X(N)=X : CHARACTER_Y(N)=Y
  65.       Set Zone N+256,X,Y To X+11,Y+11
  66.       Add X,12
  67.    Next 
  68.    Add Y,12
  69. Next 
  70. '
  71. Rem *** Set zones ***
  72. '
  73. Set Zone 322,196,66 To 207,105 : Rem put
  74. Set Zone 323,113,6 To 152,17 : Rem save 
  75. Set Zone 324,68,6 To 107,17 : Rem load 
  76. Set Zone 325,196,22 To 207,61 : Rem get
  77. Set Zone 326,211,6 To 257,17 : Rem clear edit window
  78. Set Zone 327,267,6 To 306,17 : Rem fill 
  79. Set Zone 328,212,169 To 259,180 : Rem flipx
  80. Set Zone 329,212,184 To 259,195 : Rem flipy
  81. Set Zone 330,212,154 To 251,165 : Rem inverse
  82. Set Zone 331,16,6 To 62,17 : Rem clear main grid
  83. Set Zone 332,158,6 To 197,17 : Rem quit 
  84. '
  85. Change Mouse 2
  86. L=1
  87. '
  88. '
  89. '                        
  90. '
  91. Do 
  92.    CIA=0
  93.    MOOSE=Mouse Zone
  94.    A$=Inkey$
  95.    '
  96.    '
  97.    Rem *** Check for shortcuts ***
  98.    '
  99.    '
  100.    If A$="i"
  101.       _INVERT
  102.    End If 
  103.    If A$="x"
  104.       _FLIP_X
  105.    End If 
  106.    If A$="y"
  107.       _FLIP_Y
  108.    End If 
  109.    If A$="c"
  110.       _CLEAR_MAIN_GRID
  111.    End If 
  112.    If A$="p"
  113.       Bob Off 1
  114.       _PUT
  115.    End If 
  116.    If A$="g" and STORE>0
  117.       CIA=1
  118.       _GET_ONE[STORE-1]
  119.       _GET_TWO
  120.    End If 
  121.    If A$="q"
  122.       Fade 4
  123.       Wait 50
  124.       Edit 
  125.    End If 
  126.    If A$="l"
  127.       _LOAD
  128.    End If 
  129.    If A$="s"
  130.       _SAVE
  131.    End If 
  132.    If A$="f"
  133.       _FILL
  134.       _GET_TWO
  135.       _NEW_GRID
  136.    End If 
  137.    If A$="e"
  138.       _CLEAR_GRID
  139.       _GET_TWO
  140.       _NEW_GRID
  141.    End If 
  142.    '
  143.    '
  144.    Rem *** Check mouse ***  
  145.    '
  146.    '
  147.    If Mouse Key=1 and MOOSE<257 and MOOSE>0
  148.       STORE=MOOSE
  149.       _GET_ONE[MOOSE-1]
  150.       _GET_TWO
  151.    End If 
  152.    If Mouse Key=1 and MOOSE>256 and MOOSE<321
  153.       MY=MOOSE-256
  154.       _EDIT[MY]
  155.    End If 
  156.    
  157.    If Mouse Key=1 and MOOSE=322
  158.       Bob Off 1
  159.       _INDENT[196,66,5]
  160.       _PUT
  161.    End If 
  162.    If Mouse Key=1 and MOOSE=323
  163.       _INDENT[113,6,2]
  164.       _SAVE
  165.    End If 
  166.    If Mouse Key=1 and MOOSE=324
  167.       _INDENT[68,6,2]
  168.       _LOAD
  169.    End If 
  170.    If Mouse Key=1 and MOOSE=325 and STORE>0
  171.       _INDENT[196,22,5]
  172.       CIA=1
  173.       _GET_ONE[STORE-1]
  174.       _GET_TWO
  175.    End If 
  176.    If Mouse Key=1 and MOOSE=326
  177.       _INDENT[211,6,4]
  178.       _CLEAR_GRID
  179.       _GET_TWO
  180.       _NEW_GRID
  181.    End If 
  182.    If Mouse Key=1 and MOOSE=327
  183.       _INDENT[267,6,2]
  184.       _FILL
  185.       _GET_TWO
  186.       _NEW_GRID
  187.    End If 
  188.    If Mouse Key=1 and MOOSE=328
  189.       _INDENT[212,169,3]
  190.       _FLIP_X
  191.    End If 
  192.    If Mouse Key=1 and MOOSE=329
  193.       _INDENT[212,184,3]
  194.       _FLIP_Y
  195.    End If 
  196.    If Mouse Key=1 and MOOSE=330
  197.       _INDENT[212,154,2]
  198.       _INVERT
  199.    End If 
  200.    
  201.    If Mouse Key=1 and MOOSE=331
  202.       _INDENT[16,6,4]
  203.       _CLEAR_MAIN_GRID
  204.    End If 
  205.    If Mouse Key=1 and MOOSE=332
  206.       _INDENT[158,6,2]
  207.       Fade 4
  208.       Wait 50
  209.       Edit 
  210.    End If 
  211. Loop 
  212. '
  213. '
  214. '
  215. ' *** Procedures *** 
  216. '
  217. Procedure _DISPLAY[X]
  218.    S=Start(11)+(X*8)
  219.    CP=(127)*40+(288/8)
  220.    For C=0 To 7
  221.       P=Peek(S+C)
  222.       Poke Phybase(0)+CP+C*40,P
  223.       Poke Phybase(1)+CP+C*40,P
  224.       Poke Phybase(2)+CP+C*40,P
  225.       Poke Phybase(3)+CP+C*40,P
  226.    Next 
  227.    Screen Copy 0,288,127,296,135 To 0,CHARACTER_SET_X(X+1)+2,CHARACTER_SET_Y(X+1)+2
  228. End Proc
  229. Procedure _GET_ONE[X]
  230.    L=X
  231.    Bob 1,CHARACTER_SET_X(L+1),CHARACTER_SET_Y(L+1),1
  232.    If CIA=1
  233.       Q=1
  234.       S=Start(11)+(X*8)
  235.       For C=0 To 7
  236.          P=Peek(S+C) : _VALUE(C)=P
  237.          For A=7 To 0 Step -1
  238.             If Btst(A,P)
  239.                X(Q)=1
  240.                Ink 4 : Bar CHARACTER_X(Q)+2,CHARACTER_Y(Q)+2 To CHARACTER_X(Q)+10,CHARACTER_Y(Q)+10
  241.             Else 
  242.                X(Q)=0
  243.                Ink 2 : Bar CHARACTER_X(Q)+2,CHARACTER_Y(Q)+2 To CHARACTER_X(Q)+10,CHARACTER_Y(Q)+10
  244.             End If 
  245.             Inc Q
  246.          Next 
  247.       Next 
  248.    End If 
  249. End Proc
  250. Procedure _GET_TWO
  251.    For C=0 To 7
  252.       CP=(127)*40+(288/8)
  253.       P=_VALUE(C)
  254.       Poke Phybase(0)+CP+C*40,P
  255.       Poke Phybase(1)+CP+C*40,P
  256.       Poke Phybase(2)+CP+C*40,P
  257.       Poke Phybase(3)+CP+C*40,P
  258.    Next 
  259.    Shoot 
  260.    GOS=0
  261. End Proc
  262. Procedure _EDIT[X]
  263.    NUM=7-(X-1) mod 8 : LINE=(X-1)/8
  264.    TEST=Btst(NUM,_VALUE(LINE))
  265.    If TEST=True
  266.       Ink 2
  267.       Bar CHARACTER_X(X)+2,CHARACTER_Y(X)+2 To CHARACTER_X(X)+10,CHARACTER_Y(X)+10
  268.       Bclr NUM,_VALUE(LINE)
  269.       X(X)=0
  270.    Else 
  271.       Ink 4
  272.       Bar CHARACTER_X(X)+2,CHARACTER_Y(X)+2 To CHARACTER_X(X)+10,CHARACTER_Y(X)+10
  273.       Bset NUM,_VALUE(LINE)
  274.       X(X)=1
  275.    End If 
  276.    Repeat : Until Mouse Key=0
  277.    _GET_TWO
  278. End Proc
  279. Procedure _PUT
  280.    S=Start(11)+(L*8)
  281.    For C=0 To 7
  282.       Poke S+C,_VALUE(C)
  283.    Next 
  284.    _DISPLAY[L]
  285. End Proc
  286. '
  287. Procedure _LOAD
  288.    STCURS=X
  289.    Bob Off 1
  290.    F$=Fsel$("*.font","","Load AMOS font","for editing")
  291.    If F$>""
  292.       Change Mouse 3
  293.       Bload F$,11
  294.       For N=0 To 255 : _DISPLAY[N] : Next 
  295.       X=STCURS
  296.       _GET_ONE[L] : _GET_TWO
  297.       Change Mouse 2
  298.    End If 
  299. End Proc
  300. Procedure _SAVE
  301.    STCURS=X
  302.    F$=Fsel$("*.font","","Save edited font")
  303.    If F$>"" Then Change Mouse 3 : Bsave F$,Start(11) To Start(11)+2048
  304.    X=STCURS
  305.    _GET_ONE[L]
  306.    Change Mouse 2
  307. End Proc
  308. '
  309. Procedure _CLEAR_GRID
  310.    For A=0 To 7
  311.       _VALUE(A)=0
  312.    Next 
  313. End Proc
  314. '
  315. Procedure _FILL
  316.    For A=0 To 7
  317.       _VALUE(A)=$FFF
  318.    Next 
  319. End Proc
  320. Procedure _NEW_GRID
  321.    Q=1
  322.    For C=0 To 7
  323.       For A=7 To 0 Step -1
  324.          P=_VALUE(C)
  325.          If Btst(A,P)
  326.             Ink 4 : Bar CHARACTER_X(Q)+2,CHARACTER_Y(Q)+2 To CHARACTER_X(Q)+10,CHARACTER_Y(Q)+10
  327.          Else 
  328.             Ink 2 : Bar CHARACTER_X(Q)+2,CHARACTER_Y(Q)+2 To CHARACTER_X(Q)+10,CHARACTER_Y(Q)+10
  329.          End If 
  330.          Inc Q
  331.       Next 
  332.    Next 
  333. End Proc
  334. '
  335. Procedure _INVERT
  336.    Change Mouse 3
  337.    For X=1 To 64
  338.       _EDIT[X]
  339.    Next X
  340.    Change Mouse 2
  341. End Proc
  342. '
  343. Procedure _FLIP_X
  344.    Change Mouse 3
  345.    For U=1 To 64
  346.       JON(U)=X(U)
  347.    Next U
  348.    X(8)=X(1) : X(1)=JON(8)
  349.    X(7)=X(2) : X(2)=JON(7)
  350.    X(6)=X(3) : X(3)=JON(6)
  351.    X(5)=X(4) : X(4)=JON(5)
  352.    '
  353.    X(16)=X(9) : X(9)=JON(16)
  354.    X(15)=X(10) : X(10)=JON(15)
  355.    X(14)=X(11) : X(11)=JON(14)
  356.    X(13)=X(12) : X(12)=JON(13)
  357.    '
  358.    X(24)=X(17) : X(17)=JON(24)
  359.    X(23)=X(18) : X(18)=JON(23)
  360.    X(22)=X(19) : X(19)=JON(22)
  361.    X(21)=X(20) : X(20)=JON(21)
  362.    '
  363.    X(32)=X(25) : X(25)=JON(32)
  364.    X(31)=X(26) : X(26)=JON(31)
  365.    X(30)=X(27) : X(27)=JON(30)
  366.    X(29)=X(28) : X(28)=JON(29)
  367.    '
  368.    X(40)=X(33) : X(33)=JON(40)
  369.    X(39)=X(34) : X(34)=JON(39)
  370.    X(38)=X(35) : X(35)=JON(38)
  371.    X(37)=X(36) : X(36)=JON(37)
  372.    '
  373.    X(48)=X(41) : X(41)=JON(48)
  374.    X(47)=X(42) : X(42)=JON(47)
  375.    X(46)=X(43) : X(43)=JON(46)
  376.    X(45)=X(44) : X(44)=JON(45)
  377.    '
  378.    X(56)=X(49) : X(49)=JON(56)
  379.    X(55)=X(50) : X(50)=JON(55)
  380.    X(54)=X(51) : X(51)=JON(54)
  381.    X(53)=X(52) : X(52)=JON(53)
  382.    '
  383.    X(64)=X(57) : X(57)=JON(64)
  384.    X(63)=X(58) : X(58)=JON(63)
  385.    X(62)=X(59) : X(59)=JON(62)
  386.    X(61)=X(60) : X(60)=JON(61)
  387.    '
  388.    For T=1 To 64
  389.       _FLIP_EDIT[T]
  390.    Next T
  391.    Change Mouse 2
  392. End Proc
  393. Procedure _FLIP_EDIT[X]
  394.    NUM=7-(X-1) mod 8 : LINE=(X-1)/8
  395.    If X(X)=0
  396.       Ink 2
  397.       Bar CHARACTER_X(X)+2,CHARACTER_Y(X)+2 To CHARACTER_X(X)+10,CHARACTER_Y(X)+10
  398.       Bclr NUM,_VALUE(LINE)
  399.    Else 
  400.       Ink 4
  401.       Bar CHARACTER_X(X)+2,CHARACTER_Y(X)+2 To CHARACTER_X(X)+10,CHARACTER_Y(X)+10
  402.       Bset NUM,_VALUE(LINE)
  403.    End If 
  404.    Repeat : Until Mouse Key=0
  405.    _GET_TWO
  406. End Proc
  407. Procedure _FLIP_Y
  408.    Change Mouse 3
  409.    For U=1 To 64
  410.       JON(U)=X(U)
  411.    Next U
  412.    X(57)=X(1) : X(1)=JON(57)
  413.    X(58)=X(2) : X(2)=JON(58)
  414.    X(59)=X(3) : X(3)=JON(59)
  415.    X(60)=X(4) : X(4)=JON(60)
  416.    X(61)=X(5) : X(5)=JON(61)
  417.    X(62)=X(6) : X(6)=JON(62)
  418.    X(63)=X(7) : X(7)=JON(63)
  419.    X(64)=X(8) : X(8)=JON(64)
  420.    '
  421.    X(49)=X(9) : X(9)=JON(49)
  422.    X(50)=X(10) : X(10)=JON(50)
  423.    X(51)=X(11) : X(11)=JON(51)
  424.    X(52)=X(12) : X(12)=JON(52)
  425.    X(53)=X(13) : X(13)=JON(53)
  426.    X(54)=X(14) : X(14)=JON(54)
  427.    X(55)=X(15) : X(15)=JON(55)
  428.    X(56)=X(16) : X(16)=JON(56)
  429.    '
  430.    X(41)=X(17) : X(17)=JON(41)
  431.    X(42)=X(18) : X(18)=JON(42)
  432.    X(43)=X(19) : X(19)=JON(43)
  433.    X(44)=X(20) : X(20)=JON(44)
  434.    X(45)=X(21) : X(21)=JON(45)
  435.    X(46)=X(22) : X(22)=JON(46)
  436.    X(47)=X(23) : X(23)=JON(47)
  437.    X(48)=X(24) : X(24)=JON(48)
  438.    '
  439.    X(33)=X(25) : X(25)=JON(33)
  440.    X(34)=X(26) : X(26)=JON(34)
  441.    X(35)=X(27) : X(27)=JON(35)
  442.    X(36)=X(28) : X(28)=JON(36)
  443.    X(37)=X(29) : X(29)=JON(37)
  444.    X(38)=X(30) : X(30)=JON(38)
  445.    X(39)=X(31) : X(31)=JON(39)
  446.    X(40)=X(32) : X(32)=JON(40)
  447.    '
  448.    For T=1 To 64
  449.       _FLIP_EDIT[T]
  450.    Next T
  451.    Change Mouse 2
  452. End Proc
  453. '
  454. Procedure _CLEAR_MAIN_GRID
  455.    Change Mouse 3
  456.    Bob Off 1
  457.    Y=21 : Ink 2
  458.    For L=0 To 15 : X=15
  459.       For C=1 To 16 : N=L*16+C
  460.          Bar X+2,Y+2 To X+9,Y+9
  461.          Add X,11
  462.       Next 
  463.       Add Y,11
  464.    Next 
  465.    _ERASE_ALL_DATA
  466.    Change Mouse 2
  467. End Proc
  468. Procedure _ERASE_ALL_DATA
  469.    Erase 11
  470.    Reserve As Work 11,2048
  471. End Proc
  472. '
  473. Procedure _INDENT[XIND,YIND,IMAGE]
  474.    Bob 5,XIND,YIND,IMAGE
  475.    Wait 10
  476.    Bob Off 5
  477.    Wait 5
  478. End Proc