home *** CD-ROM | disk | FTP | other *** search
/ AMOS PD CD / amospdcd.iso / sourcecode / amos1.34_progs / remmaker.amos / remmaker.amosSourceCode
Encoding:
AMOS Source Code  |  1993-01-17  |  7.8 KB  |  305 lines
  1. Rem      <-------------------------------->
  2. Rem      <                                >
  3. Rem      <    My very own REM designer    >
  4. Rem      <                                >
  5. Rem      <        Written in AMOS         >
  6. Rem      <                   ~~~~         >
  7. Rem      <           of course            >
  8. Rem      <                                >
  9. Rem      <         June 29th 1992         >
  10. Rem      <                                >
  11. Rem      <-------------------------------->
  12. '
  13. ' Keys F1 Saves the the data ready for merging into your 
  14. '         own program
  15. '      F10 Clears the display
  16. '      Up Cursor     Select top characters for scrolling 
  17. '      Down Cursor   Select bottom characters for scrolling
  18. '      Left/Right cursor scrolls the top/bottom characters 
  19. '      Escape Quits
  20. '      characters may be selected by clicking on them with the 
  21. '      mouse 
  22. '      
  23. '      NB Line draw is not yet working properly
  24. '        
  25. '
  26. Flash Off : Curs Off 
  27. Limit Mouse 127,49 To 448,298
  28. '
  29. Dim RM$(24)
  30. Global CHAR,SO1,SO2,SC,X,Y,RM$(),_FIN,_ST1$,ST2$
  31. _ST1$="Rem " : _ST2$="' "
  32. '
  33. _INIT
  34. '
  35. Do 
  36.    '
  37.    Screen 0
  38.    If Key State(96)=False Then X=X Text(X Screen(X Mouse))
  39.    If Key State(97)=False Then Y=Y Text(Y Screen(Y Mouse))
  40.    If Mouse Screen>0 Then Screen Mouse Screen
  41.    If Key State(69) Then _QUIT
  42.    If Key State(78) Then _SCRR
  43.    If Key State(79) Then _SCRL
  44.    If Key State(76) Then SC=1
  45.    If Key State(77) Then SC=2
  46.    If Mouse Screen=0 and Mouse Key=1 and Y Text(Y Screen(Y Mouse))<25
  47.       Print At(X,Y)+Chr$(CHAR)
  48.       RM$(Y)=Left$(RM$(Y),X)+Chr$(CHAR)+Right$(RM$(Y),80-(X+1))
  49.    End If 
  50.    CLK=Mouse Click
  51.    If Mouse Screen=1 and CLK=1 Then CHAR=Mouse Zone+31
  52.    If Mouse Screen=2 and CLK=1 Then CHAR=Mouse Zone+143
  53.    If Mouse Screen=3 and CLK=1
  54.       Screen 3
  55.       If Mouse Zone=1
  56.          _RUBBERBOX["L"]
  57.       End If 
  58.       If Mouse Zone=2
  59.          _RUBBERBOX["C"]
  60.       End If 
  61.       If Mouse Zone=3
  62.          _RUBBERLINE
  63.       End If 
  64.       If Mouse Zone=4
  65.          Swap _ST1$,_ST2$
  66.          Text 221,14,"   "
  67.          Text 221,14,_ST1$-Chr$(32)
  68.          Wait 10
  69.       End If 
  70.    End If 
  71.    If Key State(80) Then _REMSAVE
  72.    If Key State(89) Then _CLEAR
  73.    K$=Inkey$
  74.    If K$>=" "
  75.       Screen 0
  76.       Repeat 
  77.          Locate X,Y
  78.          Print K$;
  79.          RM$(Y)=Left$(RM$(Y),X)+K$+Right$(RM$(Y),80-(X+1))
  80.          Inc X
  81.          K$=""
  82.          Repeat 
  83.             If Key State(69)
  84.                _QUIT
  85.             End If 
  86.             K$=Inkey$
  87.          Until Asc(K$)>31 and Asc(K$)<256 or Key State(68)
  88.       Until Key State(68)
  89.       K$=""
  90.    End If 
  91.    Wait Vbl 
  92.    '
  93. Loop 
  94. '
  95. Procedure _INIT
  96.    Auto View Off 
  97.    Flash Off 
  98.    Screen Open 0,640,208,2,Hires
  99.    Flash Off : Curs Off 
  100.    Palette $8,$ED
  101.    Screen Display 0,,72,,
  102.    Screen Open 1,930,9,2,Lowres
  103.    Palette $AAA,$0
  104.    Curs Off 
  105.    Screen Open 2,930,9,2,Lowres
  106.    Get Palette 1
  107.    Curs Off 
  108.    Screen Display 2,,61,,
  109.    Screen 1
  110.    Reserve Zone 112
  111.    Print Chr$(32)+Chr$(32);
  112.    For N=32 To 143
  113.       Print Zone$(Chr$(N),N-31);
  114.    Next N
  115.    Screen 2
  116.    Reserve Zone 112
  117.    Print Chr$(32)+Chr$(32);
  118.    For N=144 To 255
  119.       Print Zone$(Chr$(N),N-143);
  120.    Next N
  121.    Screen Open 3,640,24,2,Hires
  122.    Flash Off : Curs Off 
  123.    Get Palette 1
  124.    Screen Display 3,,274,,
  125.    Reserve Zone 4
  126.    Box 10,3 To 83,19
  127.    Box 93,3 To 206,19
  128.    Box 216,3 To 335,19
  129.    Text 15,14,"Line Box"
  130.    Text 98,14,"Character Box"
  131.    Text 221,14,"Character Line"
  132.    Set Zone 1,10,3 To 83,19
  133.    Set Zone 2,93,3 To 206,19
  134.    Set Zone 3,216,3 To 335,19
  135.    Change Mouse 2
  136.    _CLEAR
  137.    Auto View On 
  138.    View 
  139.    SO1=0 : SC=1
  140. End Proc
  141. Procedure _VLINE[VX,VY,VL,ST$]
  142.    CH=0
  143.    If ST$="L" Then CH=131
  144.    If ST$="R" Then CH=132
  145.    If ST$="C" Then CH=CHAR
  146.    If CH=0 Then CH=42
  147.    Locate VX,VY
  148.    For N=1 To VL
  149.       Print At(VX,)+Chr$(CH)
  150.       If _FIN=1 Then RM$(VY+N-1)=Left$(RM$(VY+N-1),VX)+Chr$(CH)+Right$(RM$(VY+N-1),80-(VX+1))
  151.    Next N
  152. End Proc
  153. Procedure _HLINE[HX,HY,HL,ST$]
  154.    CH=0
  155.    If ST$="T" Then CH=129
  156.    If ST$="B" Then CH=134
  157.    If ST$="C" Then CH=CHAR
  158.    If CH=0 Then CH=42
  159.    Locate HX,HY
  160.    For N=1 To HL
  161.       Print Chr$(CH);
  162.       If _FIN=1 Then RM$(HY)=Left$(RM$(HY),HX+N-1)+Chr$(CH)+Right$(RM$(HY),80-(HX+N))
  163.    Next N
  164. End Proc
  165. Procedure _LBOX[HX,HY,HL,HH]
  166.    Print At(HX,HY);Chr$(128)
  167.    Print At(HX+HL,HY);Chr$(130)
  168.    Print At(HX,HY+HH);Chr$(133)
  169.    Print At(HX+HL,HY+HH);Chr$(135)
  170.    _HLINE[HX+1,HY,HL-1,"T"]
  171.    _HLINE[HX+1,HY+HH,HL-1,"B"]
  172.    _VLINE[HX,HY+1,HH-1,"L"]
  173.    _VLINE[HX+HL,HY+1,HH-1,"R"]
  174.    If _FIN=1
  175.       _FIN=0
  176.       RM$(HY)=Left$(RM$(HY),HX)+Chr$(128)+Right$(RM$(HY),80-(HX+1))
  177.       RM$(HY)=Left$(RM$(HY),HX+HL)+Chr$(130)+Right$(RM$(HY),80-(HX+HL+1))
  178.       RM$(HY+HH)=Left$(RM$(HY+HH),HX)+Chr$(133)+Right$(RM$(HY+HH),80-(HX+1))
  179.       RM$(HY+HH)=Left$(RM$(HY+HH),HX+HL)+Chr$(135)+Right$(RM$(HY+HH),80-(HX+HL+1))
  180.    End If 
  181. End Proc
  182. Procedure _CBOX[HX,HY,HL,HH]
  183.    _HLINE[HX,HY,HL+1,"C"]
  184.    _HLINE[HX,HY+HH,HL+1,"C"]
  185.    _VLINE[HX,HY+1,HH-1,"C"]
  186.    _VLINE[HX+HL,HY+1,HH-1,"C"]
  187.    If _FIN=1
  188.       _FIN=0
  189.       RM$(HY)=Left$(RM$(HY),HX)+Chr$(CHAR)+Right$(RM$(HY),80-(HX+1))
  190.       RM$(HY)=Left$(RM$(HY),HX+HL)+Chr$(CHAR)+Right$(RM$(HY),80-(HX+HL+1))
  191.       RM$(HY+HH)=Left$(RM$(HY+HH),HX)+Chr$(CHAR)+Right$(RM$(HY+HH),80-(HX+1))
  192.       RM$(HY+HH)=Left$(RM$(HY+HH),HX+HL)+Chr$(CHAR)+Right$(RM$(HY+HH),80-(HX+HL+1))
  193.    End If 
  194. End Proc
  195. Procedure _RUBBERBOX[TYPE$]
  196.    Repeat 
  197.    Until Mouse Screen=0 and Mouse Key=1
  198.    Screen 0
  199.    X1=X Text(X Screen(X Mouse)) : Y1=Y Text(Y Screen(Y Mouse))
  200.    X2=X1+1 : Y2=Y1
  201.    Writing 2
  202.    If TYPE$="L" Then _LBOX[X1,Y1,X2-X1,Y2-Y1]
  203.    If TYPE$="C" Then _CBOX[X1,Y1,X2-X1,Y2-Y1]
  204.    Repeat 
  205.       If X2<>X Text(X Screen(X Mouse)) or Y2<>Y Text(Y Screen(Y Mouse))
  206.          If TYPE$="L"
  207.             _LBOX[X1,Y1,X2-X1,Y2-Y1]
  208.          End If 
  209.          If TYPE$="C"
  210.             _CBOX[X1,Y1,X2-X1,Y2-Y1]
  211.          End If 
  212.          If Mouse Screen=0 and Y Text(Y Screen(Y Mouse))<25
  213.             X2=X Text(X Screen(X Mouse)) : Y2=Y Text(Y Screen(Y Mouse))
  214.          End If 
  215.          If X2=X1
  216.             Inc X2
  217.          End If 
  218.          If Y2=Y1
  219.             Inc Y2
  220.          End If 
  221.          If TYPE$="L"
  222.             _LBOX[X1,Y1,X2-X1,Y2-Y1]
  223.          End If 
  224.          If TYPE$="C"
  225.             _CBOX[X1,Y1,X2-X1,Y2-Y1]
  226.          End If 
  227.       End If 
  228.    Until Mouse Key=0
  229.    Writing 0
  230.    _FIN=1
  231.    If TYPE$="L" Then _LBOX[X1,Y1,X2-X1,Y2-Y1]
  232.    If TYPE$="C" Then _CBOX[X1,Y1,X2-X1,Y2-Y1]
  233.    For N=0 To 24
  234.       Locate 0,N : Print RM$(N);
  235.    Next N
  236. End Proc
  237. Procedure _RUBBERLINE
  238.    Screen 0
  239.    Repeat 
  240.    Until Mouse Screen=0 and Mouse Key=1
  241.    XRL=X Screen(X Mouse) : YRL=Y Screen(Y Mouse)
  242.    Gr Writing 3
  243.    While Mouse Screen=0 and Mouse Key=1
  244.       XT=X Screen(X Mouse) : YT=Y Screen(Y Mouse)
  245.       Draw XRL,YRL To XT,YT
  246.       Draw XRL,YRL To XT,YT
  247.    Wend 
  248.    Gr Writing 1
  249.    XRL2=X Screen(X Mouse) : YRL2=Y Screen(Y Mouse)
  250.    XA=(XRL2-XRL)/8 : YA=(YRL2-YRL)/8 : T=0
  251.    For N=XRL To XRL2 Step XA
  252.       XP=N : YP=YRL+(YA*T)
  253.       Print At(X Text(XP),Y Text(YP))+Chr$(CHAR)
  254.       Inc T
  255.    Next N
  256. End Proc
  257. Procedure _REMSAVE
  258.    For N=0 To 24
  259.       If Right$(RM$(N),1)=Chr$(32)
  260.          Repeat 
  261.             RM$(N)=Left$(RM$(N),Len(RM$(N))-1)
  262.          Until Right$(RM$(N),1)<>Chr$(32) or Len(RM$(N))=0
  263.       End If 
  264.    Next N
  265.    VP=24
  266.    If Len(RM$(24))=0
  267.       Repeat 
  268.          Dec VP
  269.       Until Len(RM$(VP))>0 or VP=0
  270.    End If 
  271.    If VP=0 and Len(RM$(0))=0 Then Pop Proc
  272.    Open Out 1,"VD0:TEMP.ASC"
  273.    For N=0 To VP
  274.       Print #1,_ST1$+RM$(N)
  275.    Next N
  276.    Close 1
  277. End Proc
  278. Procedure _CLEAR
  279.    Screen 0
  280.    T$=Space$(80)
  281.    For N=0 To 24
  282.       RM$(N)=T$
  283.       Print RM$(N)
  284.    Next N
  285. End Proc
  286. Procedure _SCRR
  287.    If SC=1 Then SO=SO1
  288.    If SC=2 Then SO=SO2
  289.    If SO<577 Then Add SO,4
  290.    Screen Offset SC,SO,
  291.    If SC=1 Then SO1=SO
  292.    If SC=2 Then SO2=SO
  293. End Proc
  294. Procedure _SCRL
  295.    If SC=1 Then SO=SO1
  296.    If SC=2 Then SO=SO2
  297.    If SO>0 Then Add SO,-4
  298.    Screen Offset SC,SO,
  299.    If SC=1 Then SO1=SO
  300.    If SC=2 Then SO2=SO
  301. End Proc
  302. Procedure _QUIT
  303.    Default 
  304.    Edit 
  305. End Proc