home *** CD-ROM | disk | FTP | other *** search
/ The Datafile PD-CD 3 / PDCD_3.iso / pocketbk / pictures / eikon / EIKON.OPL < prev    next >
Text File  |  1993-12-30  |  11KB  |  649 lines
  1. REM Eikon v0.94
  2. REM Icon editor for the Series 3a
  3. REM by Roger Burton-West <ubte30e@ucl.ac.uk>
  4. REM copy freely and of your own will
  5.  
  6. REM Expansion routine partially inspired by Alain's "iconeg"
  7. REM Thanks to beta-tester: Sean Desmond <scd@uk.ac.st-and>
  8.  
  9. APP Eikon
  10.     TYPE $1003
  11.     PATH "\OPD"
  12.     EXT "PIC"
  13.     ICON "\OPD\EIKON.PIC"
  14. ENDA
  15.  
  16. PROC icon:
  17.     global we%,wp%,wb%,wg%,wcp%,ww%,l%,x%,y%,md%,fh%
  18.     global a%(32),k%,s%,f$(128),ap%
  19.     local f%,ft%,fs%(6),t$(10)
  20.     local cl%,cx%,cy%,w$(128),ct%,bx&,by&,dp%,wr%
  21.     local cp%,cpx%,cpy%,fn$(130)
  22.     lock on
  23.     setpath "\OPD"
  24.     REM we is edit window, wp is preview;
  25.     REM wb and wg are black/grey previews;
  26.     REM wcp is cut/paste buffer, ww is work buffer
  27.     we%=gCREATE(8,8,144,144,1,1)
  28.     wp%=gCREATE(228,16,48,48,1,1)
  29.     wb%=gCREATE(174,96,48,48,1,0)
  30.     wg%=gCREATE(282,96,48,48,1,1)
  31.     wcp%=gCREATE(336,16,48,48,0,1)
  32.     ww%=gCREATE(0,0,48,48,0,1)
  33.     f$=cmd$(2)
  34.     if cmd$(3)="C"
  35.         crt:(f$)
  36.     elseif cmd$(3)="O"
  37.         lod:(f$)
  38.     endif
  39.     bx&=1
  40.     by&=1
  41.     dp%=3
  42.     f%=12
  43.     cl%=1
  44.     do
  45.         fs%(cl%)=2
  46.         cl%=cl%+1
  47.     until cl%=7
  48.     fn$="ROM::\OPD\*.FON"
  49.     diaminit 3,"White","Grey","Black"
  50.     statuswin ON,2
  51.     giprint "Eikon v0.94 ¸ 1993 Roger Burton-West"
  52.     winone:
  53.     gUSE 1
  54.     gAT 7,7
  55.     gBOX 146,146
  56.     gUSE we%
  57.     lock off
  58.     do
  59.         k%=0
  60.         s%=0
  61.         gUSE 1
  62.         gAT 8+x%*3,0
  63.         gFILL bx&*3,7,0
  64.         gAT 0,8+y%*3
  65.         gFILL 7,by&*3,0
  66.         gAT 8+x%*3,153
  67.         gFILL bx&*3,7,0
  68.         gAT 153,8+y%*3
  69.         gFILL 7,by&*3,0
  70.         gUSE we%
  71.         gGREY 2
  72.         gGMODE 2
  73.         gAT x%*3,y%*3
  74.         cursor we%,0,bx&*3,by&*3
  75.         do
  76.             getk:
  77.         until k%
  78.         cursor off
  79.         gUSE 1
  80.         gAT 8+x%*3,0
  81.         gFILL bx&*3,7,1
  82.         gAT 0,8+y%*3
  83.         gFILL 7,by&*3,1
  84.         gAT 8+x%*3,153
  85.         gFILL bx&*3,7,1
  86.         gAT 153,8+y%*3
  87.         gFILL 7,by&*3,1
  88.         gUSE we%
  89.         gGMODE 0
  90.         gGREY 0
  91.         if k%=290
  92.             mINIT
  93.             mCARD "File","New file",%n,"Open file",%o,"Save as",%a,"Save",%s,"Revert",%v
  94.             mCARD "Edit","Insert",%i,"Copy",%c
  95.             mCARD "Effects","Invert",%r,"Add Black > Grey",%g,"Brush size",%b,"Small brush",%h,"Paste brush",%p,"Text",%t
  96.             mCARD "Settings","Scroll wrap",%w
  97.             mCARD "Special","Exit",%x
  98.             k%=MENU
  99.             s%=0
  100.         endif
  101.         k%=k% and 511
  102.         if k%=292
  103.             if s% and 2
  104.                 dp%=dp%-1
  105.                 if dp%=0
  106.                     dp%=3
  107.                 endif
  108.             else
  109.                 dp%=dp%+1
  110.                 if dp%=4
  111.                     dp%=1
  112.                 endif
  113.             endif
  114.             diampos dp%
  115.         endif
  116.         if k%=%n
  117.             sav:(f$)
  118.             lock on
  119.             dINIT "Create new file"
  120.             f$="\OPD\.pic"
  121.             dFILE f$,"File:",17
  122.             if DIALOG
  123.                 f$=parse$(f$,"\OPD\*.PIC",a%())
  124.                 crt:(f$)
  125.             endif
  126.             lock off
  127.         elseif k%=%s
  128.             sav:(f$)
  129.             giprint "Saved"
  130.         elseif k%=%v
  131.             if md%
  132.                 dINIT "Revert to saved?"
  133.                 dBUTTONS "No",%N,"Yes",%Y
  134.                 if dialog=%y
  135.                     dcl:
  136.                     lod:(f$)
  137.                 endif
  138.             else
  139.                 giprint "Not changed"
  140.             endif
  141.         elseif k%=%a
  142.             cl%=1
  143.             ct%=md%
  144.             lock on
  145.             dINIT "Save as"
  146.             w$="\OPD\.pic"
  147.             dFILE w$,"File:",17
  148.             dCHOICE cl%,"Use new file","No,Yes"
  149.             if DIALOG
  150.                 w$=parse$(w$,"\OPD\*.PIC",a%())
  151.                 md%=-1
  152.                 sav:(w$)
  153.                 if cl%=2
  154.                     f$=w$
  155.                     setname f$
  156.                 else
  157.                     md%=ct%
  158.                 endif
  159.                 if exist(f$)
  160.                     ioopen(fh%,f$,256)
  161.                 else
  162.                     ioopen(fh%,f$,257)
  163.                 endif
  164.             endif
  165.             lock off
  166.         elseif k%=%o
  167.             sav:(f$)
  168.             dINIT "Load icon"
  169.             f$="\OPD\.pic"
  170.             dFILE f$,"File:",8
  171.             f$=parse$(f$,"\OPD\*.PIC",a%())
  172.             if DIALOG
  173.                 lod:(f$)
  174.             endif
  175.         elseif k%=%c
  176.             cp%=1
  177.             gUSE wcp%
  178.             gGREY 2
  179.             gAT 0,0
  180.             gCOPY wp%,x%,y%,bx&,by&,3
  181.             cpx%=bx&
  182.             cpy%=by&
  183.             gUSE we%
  184.             giprint "Copied"
  185.         elseif k%=%i
  186.             if cp%=0
  187.                 giprint "Buffer is empty"
  188.             else
  189.                 gUSE wp%
  190.                 gGREY 2
  191.                 gAT x%,y%
  192.                 gCOPY wcp%,0,0,cpx%,cpy%,3
  193.                 md%=1
  194.                 update21:
  195.             endif
  196.         elseif k%=%t
  197.             if cp%=1
  198.                 giprint "Text will overwrite paste buffer"
  199.             endif
  200.             dINIT "Insert text"
  201.             dEDIT t$,"Text:"
  202.             dCHOICE f%,"Font:","S3 normal,S3 bold,S3 digits,Mono 8x8,Roman 8,Roman 11,Roman 13,Roman 16,Swiss 8,Swiss 11,Swiss 13,Swiss 16,Mono 6x6,Custom"
  203.             dCHOICE fs%(1),"Bold:","Yes,No"
  204.             dCHOICE fs%(2),"Underlined:","Yes,No"
  205.             dCHOICE fs%(4),"Double height:","Yes,No"
  206.             dCHOICE fs%(5),"Monospace:","Yes,No"
  207.             dCHOICE fs%(6),"Italic:","Yes,No"
  208.             if DIALOG
  209.                 if f%=14
  210.                     dINIT "Choose custom font"
  211.                     dFILE fn$,"Font:",8
  212.                     if DIALOG=0
  213.                         f%=7
  214.                     endif
  215.                     f%=gLOADFONT(fn$)
  216.                 endif
  217.                 gUSE wcp%
  218.                 ft%=0
  219.                 cl%=1
  220.                 do
  221.                     if fs%(cl%)=1
  222.                         ft%=ft%+2**(cl%-1)
  223.                     endif
  224.                     cl%=cl%+1
  225.                 until cl%=7
  226.                 gFONT f%
  227.                 gSTYLE ft%
  228.                 if gTWIDTH(t$)>48
  229.                     giprint "Text too long"
  230.                 else
  231.                     whichco:("background")
  232.                     gINFO a%()
  233.                     bx&=min(48,gTWIDTH(t$))
  234.                     by&=min(48,a%(4)+a%(5))
  235.                     x%=min(x%,48-bx&)
  236.                     y%=min(y%,48-by&)
  237.                     cpx%=bx&
  238.                     cpy%=by&
  239.                     gGREY 2
  240.                     gCLS
  241.                     if ap%=2
  242.                         gGREY 1
  243.                         gFILL cpx%,cpy%,0
  244.                     elseif ap%=3
  245.                         gGREY 2
  246.                         gFILL cpx%,cpy%,0
  247.                     endif
  248.                     gAT 0,a%(5)
  249.                     if dp%=1
  250.                         gGREY 2
  251.                         gTMODE 1
  252.                     elseif dp%=2
  253.                         gGREY 1
  254.                         gTMODE 0
  255.                     elseif dp%=3
  256.                         gGREY 2
  257.                         gTMODE 0
  258.                     endif
  259.                     gPRINTCLIP(t$,48)
  260.                     if dp%=2 and ap%=3
  261.                         gAT 0,a%(5)
  262.                         gGREY 0
  263.                         gTMODE 1
  264.                         gPRINTCLIP(t$,48)
  265.                     endif
  266.                     gUSE we%
  267.                     cp%=1
  268.                 endif
  269.                 if f%>13
  270.                     gUNLOADFONT f%
  271.                 endif
  272.             endif
  273.         elseif k%=%w
  274.             wr%=1-wr%
  275.             if wr%=0
  276.                 giprint "Scroll wrap is OFF"
  277.             else
  278.                 giprint "Scroll wrap is ON"
  279.             endif
  280.         elseif k%=%g
  281.             gUSE wp%
  282.             gAT 0,0
  283.             gGREY 1
  284.             gCOPY wb%,0,0,48,48,0
  285.             gUSE we%
  286.             md%=-1
  287.             updatebg:
  288.         elseif k%=%b
  289.             dINIT "Brush size"
  290.             dLONG bx&,"X size:",1,48
  291.             dLONG by&,"Y size:",1,48
  292.             DIALOG
  293.             x%=min(x%,48-bx&)
  294.             y%=min(y%,48-by&)
  295.         elseif k%=%h
  296.             bx&=1
  297.             by&=1
  298.         elseif k%=%p
  299.             if cp%=0
  300.                 giprint "Buffer is empty"
  301.             else
  302.                 bx&=cpx%
  303.                 by&=cpy%
  304.                 x%=min(x%,48-bx&)
  305.                 y%=min(y%,48-by&)
  306.             endif
  307.         elseif k%=%r
  308.             whichpl:
  309.             giprint "Invert"
  310.             gUSE wp%
  311.             gAT 0,0
  312.             if ap%=1
  313.                 gGREY 2
  314.                 gFILL 48,48,2
  315.             elseif ap%=2
  316.                 gGREY 2
  317.                 gCOPY wb%,0,0,48,48,1
  318.                 gGREY 0
  319.                 gCLS
  320.                 gGREY 1
  321.                 gFILL 48,48,2
  322.                 gGREY 0
  323.                 gCOPY wb%,0,0,48,48,0
  324.             elseif ap%=3
  325.                 gGREY 0
  326.                 gFILL 48,48,2
  327.             endif
  328.             gUSE we%
  329.             update21:
  330.             giprint ""
  331.             md%=-1
  332.         elseif s% and 2
  333.             if k%=256
  334.                 by&=max(by&-1,1)
  335.             elseif k%=257
  336.                 by&=min(by&+1,48)
  337.                 y%=min(y%,48-by&)
  338.             elseif k%=258
  339.                 bx&=min(bx&+1,48)
  340.                 x%=min(x%,48-bx&)
  341.             elseif k%=259
  342.                 bx&=max(bx&-1,1)
  343.             endif
  344.         elseif s% and 4
  345.             cx%=0
  346.             cy%=0
  347.             if wr%=1
  348.                 gUSE ww%
  349.                 gGREY 2
  350.                 gCOPY wp%,0,0,48,48,3
  351.             endif
  352.             if k%=256
  353.                 cy%=-1
  354.             elseif k%=257
  355.                 cy%=1
  356.             elseif k%=258
  357.                 cx%=1
  358.             elseif k%=259
  359.                 cx%=-1
  360.             elseif k%=260
  361.                 cy%=-by&
  362.             elseif k%=261
  363.                 cy%=by&
  364.             elseif k%=262
  365.                 cx%=-bx&
  366.             elseif k%=263
  367.                 cx%=bx&
  368.             endif
  369.             gUSE wp%
  370.             gGREY 2
  371.             gSCROLL cx%,cy%
  372.             gUSE we%
  373.             gGREY 2
  374.             gSCROLL cx%*3,cy%*3
  375.             x%=min(max(x%+cx%,0),47)
  376.             y%=min(max(y%+cy%,0),47)
  377.             if wr%=1
  378.                 gUSE wp%
  379.                 if cx%<0
  380.                     gAT 48+cx%,0
  381.                     gCOPY ww%,0,0,-cx%,48,3
  382.                 elseif cx%>0
  383.                     gAT 0,0
  384.                     gCOPY ww%,48-cx%,0,cx%,48,3
  385.                 elseif cy%<0
  386.                     gAT 0,48+cy%
  387.                     gCOPY ww%,0,0,48,-cy%,3
  388.                 elseif cy%>0
  389.                     gAT 0,0
  390.                     gCOPY ww%,0,48-cy%,48,cy%,3
  391.                 endif
  392.                 update21:
  393.             else
  394.                 updatebg:
  395.             endif
  396.             gUSE we%
  397.             md%=-1
  398.         elseif k%=256
  399.             y%=max(y%-1,0)
  400.         elseif k%=257
  401.             y%=min(y%+1,48-by&)
  402.         elseif k%=258
  403.             x%=min(x%+1,48-bx&)
  404.         elseif k%=259
  405.             x%=max(x%-1,0)
  406.         elseif k%=260
  407.             y%=max(y%-by&,0)
  408.         elseif k%=261
  409.             y%=min(y%+by&,48-by&)
  410.         elseif k%=262
  411.             x%=max(x%-bx&,0)
  412.         elseif k%=263
  413.             x%=min(x%+bx&,48-bx&)
  414.         elseif k%=13
  415.             gUSE we%
  416.             gAT x%*3,y%*3
  417.             if dp%=1
  418.                 gGREY 2
  419.                 gFILL 3*bx&,3*by&,1
  420.                 gUSE wp%
  421.                 gGREY 2
  422.                 gAT x%,y%
  423.                 gFILL bx&,by&,1
  424.             elseif dp%=2
  425.                 gGREY 1
  426.                 gFILL 3*bx&,3*by&,0
  427.                 gGREY 0
  428.                 gFILL 3*bx&,3*by&,1
  429.                 gUSE wp%
  430.                 gAT x%,y%
  431.                 gGREY 1
  432.                 gFILL bx&,by&,0
  433.                 gGREY 0
  434.                 gFILL bx&,by&,1
  435.             elseif dp%=3
  436.                 gGREY 2
  437.                 gFILL 3*bx&,3*by&,0
  438.                 gUSE wp%
  439.                 gGREY 2
  440.                 gAT x%,y%
  441.                 gFILL bx&,by&,0
  442.             endif
  443.             updatebg:
  444.             gGREY 0
  445.             gUSE we%
  446.