home *** CD-ROM | disk | FTP | other *** search
/ The Datafile PD-CD 3 / PDCD_3.iso / pocketbk / pictures / picdraw1 / PICDRAW.OPL < prev    next >
Text File  |  1993-01-12  |  13KB  |  699 lines
  1. app PicDraw
  2.     type 2
  3.     path "\opd"
  4.     ext "pic"
  5.     icon "\opd\picdraw.pic"
  6. enda
  7.  
  8. proc PicDraw:
  9.     global PDrName$(128)
  10.     global menu$(20)
  11.     rem For GetEvent
  12.     global a%(6)
  13.     rem Coordinates of icon and cursor
  14.     global orgx%, orgy%, height%, width%
  15.     global curx%, cury%, pos%
  16.     global copybx%,copyby%,copyex%,copyey%
  17.     global wId%, statId%,copyId%
  18.     global stMode%,stCut%
  19.     gSetWin 0,0,180,80
  20.     Screen 30,9,1,1
  21.      menu$ = "OSRNXCVPABWYMDLITHZ"
  22.     PDrName$=Cmd$(2)
  23.     rem Default values
  24.     wId%=0 :statId%=0 :stMode%=3 :pos%=1
  25.     width%=24 : height%=24
  26.     DrawStat:(1)
  27.     if DoFile:(Cmd$(3)) = 1
  28.         rem Inicialization of Icon window
  29.         DrawWin:(24,24)
  30.     endif
  31.     do
  32.         ReadKey:
  33.     until 0
  34. endp
  35.  
  36. proc DoFile:(t$) :rem Create or Open File
  37.     if t$="C"
  38.         NewIcon:
  39.         return 1
  40.     elseif t$="O"
  41.         OpenIcon:
  42.         return 0
  43.     elseif t$="X"
  44.         SaveIcon:
  45.         return 1
  46.     endif
  47.     if Err
  48.         Cls : Print Err$(Err)
  49.         Get : Stop
  50.     endif
  51.     PutName:(PDrName$)
  52. endp
  53.  
  54. proc ReadKey:
  55.     local k%,mod%,a$(5),t$(1)
  56.     
  57.     GetEvent a%()
  58.     if a%(1)=$404
  59.         PDrName$=GetCmd$
  60.         t$=Left$(PDrName$, 1)
  61.         PDrName$=Mid$(PDrName$,2,128)
  62.         if t$="X"
  63.             SaveIcon:
  64.             Stop
  65.         elseif t$="C" or t$="O"
  66.             DoFile:(t$)
  67.         endif
  68.     endif
  69.     mod%=a%(2) and $00ff
  70.     if a%(1)=$122
  71.         mInit
  72.         mCard "File","New Icon",%N,"Open Icon",%O,"Save Icon",%S,"Merge Icon",%R,"Exit",%X
  73.         mCard "Modes","Move",%M,"Draw",%D,"Clear",%L,"Invert",%I
  74.         mCard "Region","Copy",%C,"Cut",%V,"Paste",%P
  75.         mCard "Scroll","Insert Row",%A,"Insert Column",%B,"Delete Row",%W,"Delete Column",%Y
  76.         mCard "Text","Add Text...",%T
  77.         mCard "Settings","Change Settings...",%H,"Zoom",%Z
  78.         k%=menu 
  79.         if k% and intf(loc(menu$, chr$(k%)))
  80.             a$="proc"+chr$(k%)
  81.             if @(a$): = 0
  82.                 return k%
  83.             endif
  84.         endif
  85.     elseif a%(1) and $200
  86.         k%=(a%(1)-$200)
  87.         k%=loc(menu$, chr$(k%))
  88.         if k%
  89.             a$="proc"+mid$(menu$,k%,1)
  90.             if @(a$): = 0
  91.                 return k%
  92.             endif
  93.         else
  94.             giPrint "Unknown option "+chr$(2)+"-"+chr$(a%(1))
  95.         endif
  96.     elseif a%(1)=27 : rem clear on/off
  97.         if stMode% < 4
  98.             procl:
  99.         endif
  100.     elseif a%(1)=32 : rem plot pixel
  101.         PutPixel:(0)
  102.     elseif a%(1)=8 : rem clear pixel
  103.         PutPixel:(1)
  104.     elseif a%(1)=9 : rem invert pixel
  105.         PutPixel:(2)
  106.     elseif a%(1)=13 : rem draw on/off
  107.         if stMode% < 4
  108.             procd:
  109.         else : rem selected a region to copy
  110.             copyex%=curx%+1
  111.             copyey%=cury%+1
  112.             CopyIcon:
  113.             gIPrint "Copied"
  114.             stMode%=3
  115.             DrawStat:(0)
  116.         endif
  117.     elseif (a%(1)=261) :rem pgdn
  118.         cury%=height%-1
  119.         DrawCur:
  120.     elseif (a%(1)=260):rem pgup
  121.         cury%=0
  122.         DrawCur:
  123.     elseif (a%(1)=262) :rem home
  124.         curx%=0
  125.         DrawCur:
  126.     elseif (a%(1)=263) :rem end
  127.         curx%=width%-1
  128.         DrawCur:
  129.     elseif a%(1)=258 and (mod% and 4)
  130.         curx%=curx%+4
  131.         if curx% > width% - 1
  132.             curx%=0
  133.         endif
  134.         DrawCur:
  135.     elseif a%(1)=259 and (mod% and 4)
  136.         curx%=curx%-4
  137.         if curx% < 0
  138.             curx% = width%-1
  139.         endif
  140.         DrawCur:        
  141.     elseif a%(1)=257 and (mod% and 4)
  142.         cury%=cury%+4
  143.         if cury% > height% - 1
  144.             cury%=0
  145.         endif
  146.         DrawCur:
  147.     elseif a%(1)=256 and (mod% and 4)
  148.         cury%=cury%-4
  149.         if cury% < 0
  150.             cury%=height%-1
  151.         endif
  152.         DrawCur:        
  153.     elseif a%(1)=258
  154.         if curx% < width% - 1
  155.             curx%=curx%+1
  156.         else curx%=0
  157.         endif
  158.         DrawCur:
  159.     elseif a%(1)=259
  160.         if curx% > 0
  161.             curx%=curx%-1
  162.         else curx% = width%-1
  163.         endif
  164.         DrawCur:        
  165.     elseif a%(1)=257
  166.         if cury% < height% - 1
  167.             cury%=cury%+1
  168.         else cury%=0
  169.         endif
  170.         DrawCur:
  171.     elseif a%(1)=256
  172.         if cury% > 0
  173.             cury%=cury%-1
  174.         else cury%=height%-1
  175.         endif
  176.         DrawCur:
  177.     elseif a%(1)=291
  178.         ShowHelp:
  179.     endif
  180.     return a%(1)
  181. endp
  182.  
  183. proc PutPixel:(mode%)
  184.     if stMode% < 4
  185.         gGMode mode%
  186.         gLineBy 0,0
  187.         if stMode%<>3
  188.             gGMode stMode%
  189.         endif
  190.     endif
  191. endp
  192.  
  193. proc DrawCur:
  194.     gUpdate Off
  195.     gUse statId%
  196.     gAt 6,60
  197.     gPrintB gen$(curx%,3)+gen$(cury%,-3),48,3,1,1,1
  198.     gUse wId%
  199.     gAt curx%,cury%
  200.     if stMode%<3
  201.         gGMode stMode%
  202.         gLineBy 0,0
  203.     endif
  204.     gUpdate On
  205. endp
  206.  
  207. proc DrawWin:(wx%,wy%)
  208.     if wx% > 178 or wy% > 78
  209.         raise -2
  210.     endif
  211.     gUpdate Off
  212.     width%=wx% : height%=wy%
  213.     if pos%=1 : rem centred
  214.         orgx%=(180-wx%)/2
  215.         orgy%= (80-wy%)/2
  216.     else : rem top left
  217.         orgx%=1 : orgy%=2
  218.     endif
  219.     gUse 1
  220.     gOrder 1,1
  221.     gCls
  222.     gAt orgx%-1,orgy%-1
  223.     gGMode 0
  224.     gBox width%+2,height%+2
  225.     if wId% <> 0
  226.         gClose wId%
  227.     endif
  228.     wId% = gCreate(orgx%,orgy%,width%,height%,1)
  229.     gOrder wId%,1
  230.     gUse wId%
  231.     Cursor wId%,0,1,1
  232.     DrawCur:
  233. endp
  234.  
  235. proc DrawStat:(mode%)
  236.     local s$(6),tempid%,fname$(128)
  237.     
  238.     gUpdate Off
  239.     if mode%=1 : rem New Status Window
  240.         fname$="\app\picdraw.pic"
  241.         if exist(fname$)
  242.             tempid%=gLoadBit(fname$,0)
  243.         else
  244.             fname$="\opd\picdraw.pic"
  245.             if exist(fname$)
  246.                 tempid%=gLoadBit(fname$,0)
  247.             else
  248.                 tempid%=gCreateBit(24,24)
  249.                 gCls
  250.                 gAt 0,12
  251.                 gPrintB "Pic",24,3
  252.                 gAt 0,20
  253.                 gPrintB "Draw",24,3
  254.             endif
  255.         endif
  256.         if statId% <> 0
  257.             gClose statId%
  258.         endif
  259.         statId%=gCreate(181,0,59,80,1)
  260.         gBorder 0
  261.         gFont 1
  262.         gStyle 4
  263.         gAt 18,12
  264.         gCopy tempid%,0,0,24,24,3
  265.         gClose tempid%
  266.     endif
  267.     vector stMode%+1
  268.         lab1,lab2,lab3,lab4
  269.         lab5
  270.     endv
  271.     s$="None"
  272.     goto labx
  273.     lab1::
  274.         s$="Draw"
  275.         goto labx
  276.     lab2::
  277.         s$="Clear"
  278.         goto labx
  279.     lab3::
  280.         s$="Invert"
  281.         goto labx
  282.     lab4::
  283.         s$="Move"
  284.         goto labx
  285.     lab5::
  286.         s$="Select"
  287.     labx::
  288.         gUse statId%
  289.         gAt 6,72
  290.         gPrintB s$,48,3,1,1,1
  291.         if wId%<>0
  292.             gUse wId%
  293.         endif
  294.         gUpdate On
  295. endp
  296.  
  297. proc ShowHelp:
  298. start::
  299.     dInit
  300.     dText "","Help: PicDraw",$302
  301.     dText "","þMovement",$500
  302.     dText "","þModes",$500
  303.     dText "","þRegions",$500
  304.     dText "","þScrolling",$500
  305.     dText "","þText",$500
  306.     dText "","þAbout",$500
  307.     vector dialog-1
  308.         lab1,lab2,lab3,lab4,lab5
  309.         lab6
  310.     endv
  311.     return 1
  312.     lab1::
  313.         dInit
  314.         dText "","Help: Movement",$302
  315.         dText "","Use cursor keys to move around; if you"
  316.         dText "","press Control, cursor moves faster."
  317.         dText "","Space plots a pixel, Delete clears a pixel."
  318.         dText "","Tab inverts the pixel at the cursor."
  319.         goto labx
  320.     lab2::
  321.         dInit
  322.         dText "","Help: Modes",$302
  323.         dText "","Enter toggles the ""Draw"" mode, Esc"
  324.         dText "","toggles the ""Clear"" mode."
  325.         dText "","Psion-I toggles the ""Invert"" mode; this"
  326.         dText "","is useful for some special effects." 
  327.         dText "","Press Psion-M to restore ""Move"" mode."
  328.         dText "","The mode affects ""Paste"" and ""Merge Icon""."
  329.         goto labx
  330.     lab3::
  331.         dInit
  332.         dText "","Help: Regions",$302
  333.         dText "","Selecting ""Copy"" or ""Cut"" enters ""Select"""
  334.         dText "","mode; current cursor position is top left,"
  335.         dText "","move cursor to bottom right, press Enter"
  336.         dText "","to select region to copy. ""Paste"" puts the"
  337.         dText "","the selected region on the curr. position."
  338.         dText "","""Cut"" also clears the original region."
  339.         goto labx
  340.     lab4::
  341.         dInit
  342.         dText "","Help: Scrolling",$302
  343.         dText "","Scrolling takes effect from the current"
  344.         dText "","position; ""Insert Row"" moves down, ""Insert"
  345.         dText "","Column"" moves right, ""Delete Row"""
  346.         dText "","moves up and ""Delete Column"" moves left."
  347.         goto labx
  348.     lab5::
  349.         dInit
  350.         dText "","Help: Text",$302
  351.         dText "","Text is inserted at the current position,"
  352.         dText "","and the cursor moves to the right of the"
  353.         dText "","inserted text. Type the text in the"
  354.         dText "","dialog box and select font, style and"
  355.         dText "","mode (overwrite, clear or invert)."
  356.         dText "","Text is not reeditable; you must retype it."
  357.         goto labx
  358.     lab6::
  359.         dInit
  360.         dText "","About PicDraw v. 1.0",$302
  361.         dText "", "(c) 1993 by Lu¡s Miguel Sequeira",2
  362.         dText "", "(bc@fccn01.fccn.pt)",2
  363.         dText "", " "
  364.         dText "", "This program is freeware;",2
  365.         dText "", "feel free to copy and give it away!",2
  366.     labx::
  367.         if dialog=0
  368.             goto start
  369.         endif
  370.         return 1
  371. endp
  372.  
  373. proc NewIcon:
  374.     if wId% <> 0
  375.         gUse wId%
  376.         gCls
  377.     endif
  378.     curx%=0 :cury%=0
  379. endp
  380.  
  381. proc procn: rem New Icon
  382.     Lock On
  383.     dInit "New Icon"
  384.     dButtons "No",%N,"Yes",%Y
  385.     if dialog = %y
  386.         NewIcon:
  387.     endif
  388.     Lock Off
  389.     return 1
  390. endp
  391.  
  392. proc OpenIcon:
  393.     local tempId%,th%,tw%
  394.     
  395.     if exist(PDrName$)
  396.         Busy "Loading..."
  397.         PutName:(PDrName$)
  398.         tempId%=gLoadBit(PDrName$)
  399.     else
  400.         tempId%=gCreateBit(width%,height%)
  401.     endif
  402.     curx%=0 :cury%=0
  403.     th%=min(gHeight,78) :tw%=min(gWidth,178)
  404.     Dra