home *** CD-ROM | disk | FTP | other *** search
/ PDA Software Library / pdasoftwarelib.iso / PSION / GAMES / SLED / OPL / SLED.OPL
Encoding:
Text File  |  1995-10-03  |  20.2 KB  |  1,046 lines
  1. APP Sled
  2.     path "\app\stigma\"
  3.     ext "lev"
  4.     icon "\opd\sled.pic"
  5.     type $1003
  6. ENDA
  7.  
  8. PROC sled:
  9.     global graphic%,drive$(1),ep%,cp%
  10.     global cx%,cy%,disp%,tle%,l$(120),sx%,sy%,ex%
  11.     global gw%,id$(60,15),pid%,comm%,tg$(30),dr$(1)
  12.     local c$(1),f$(128),ev%(6),dmode%,smode%
  13.     local gcx%,gcy%,gcw%,gch%,wv%,chg%
  14.     local t%,t&,a,f,d%,n$(5),f2$(128)
  15.     local jx%,jy%
  16.     callme:("Sled")
  17.     defaultwin 0
  18.     tg$=":\app\stigma\"
  19.     IF EXIST("M"+tg$+"stigma.gfx")
  20.         tg$="M"+tg$
  21.     ELSEIF EXIST("A"+tg$+"stigma.gfx")
  22.         tg$="A"+tg$
  23.     ELSEIF EXIST("B"+tg$+"stigma.gfx")
  24.         tg$="B"+tg$
  25.     ENDIF
  26.     graphic%=gloadbit(tg$+"stigma.gfx",0,0)
  27.     if graphic%<2
  28.         raise -33
  29.     endif
  30.     IF EXIST("M:\app\stigma.app")
  31.         comm%=1
  32.         dr$="M"
  33.     ELSEIF EXIST("A:\app\stigma.app")
  34.         comm%=1
  35.         dr$="A"
  36.     ELSEIF EXIST("B:\app\stigma.app")
  37.         comm%=1
  38.         dr$="B"
  39.     ENDIF
  40.     IF EXIST("M:\app\stigma_s.gam")
  41.         dr$="M"
  42.     ELSEIF EXIST("A:\app\stigma_s.gam")
  43.         dr$="A"
  44.     ELSEIF EXIST("B:\app\stigma_s.gam")
  45.         dr$="B"
  46.     ENDIF
  47.     if dr$=""
  48.         raise -33
  49.     endif
  50.     disp%=gCREATE(299,54,122,52,0,1)
  51.     gXBORDER 1,$403
  52.     setstr:
  53.     setpick:
  54.     gUSE 1
  55.     gSETWIN 0,0,416,160
  56.     screen 30,12
  57.     statuswin ON,2
  58.     wv%=1
  59.     ep%=1
  60.     cp%=1
  61.     dmode%=1
  62.     diaminit 1,"Levels","Editor"
  63.     c$=cmd$(3)
  64.     f$=cmd$(2)
  65.     if c$="O"
  66.         xopen:(f$)
  67.     else
  68.         xcreate:(f$)
  69.     endif
  70.     tle%=1
  71.     update:(1,3)
  72.     gcx%=4
  73.     gcy%=4
  74.     gcw%=168
  75.     gch%=72
  76.     do
  77.         gAT gcx%,gcy%
  78.         cursor 1,0,gcw%,gch%,1
  79.         getevent ev%()
  80.         cursor off
  81.         if ev%(1)=$404
  82.             f$=getcmd$
  83.             c$=left$(f$,1)
  84.             f$=mid$(f$,2,128)
  85.             if c$="C"
  86.                 close
  87.                 xcreate:(f$)
  88.             elseif c$="O"
  89.                     close
  90.                 xopen:(f$)
  91.             elseif c$="X"
  92.                 close
  93.                 return
  94.             endif
  95.         elseif (ev%(1) and $400)=0 :rem keypress
  96.             if ev%(1)=292
  97.                 dmode%=3-dmode%
  98.                 diampos dmode%
  99.                 if dmode%=1
  100.                     gUSE disp%
  101.                     gvisible off
  102.                     gUSE 1
  103.                     gcx%=4
  104.                     gcw%=168
  105.                     gch%=72
  106.                     statuswin on,2
  107.                     gSETWIN 0,0,416,160
  108.                     position cp%
  109.                     if chg%
  110.                         a.layout$=l$
  111.                         a.startx%=sx%
  112.                         a.starty%=sy%
  113.                         a.exit%=ex%
  114.                         update
  115.                         churn:(0,cp%)
  116.                     endif
  117.                 else
  118.                     cx%=0
  119.                     cy%=0
  120.                     jx%=1
  121.                     jy%=1
  122.                     gcw%=24
  123.                     gch%=24
  124.                     smode%=1
  125.                     chg%=0
  126.                     statuswin off
  127.                     gSETWIN 0,0,480,160
  128.                     position cp%
  129.                     l$=a.layout$
  130.                     sx%=a.startx%
  131.                     sy%=a.starty%
  132.                     ex%=a.exit%
  133.                     if wv%
  134.                         gUSE disp%
  135.                         gSETWIN 299,54
  136.                         gvisible on
  137.                     endif
  138.                     gUSE 1
  139.                 endif
  140.                 update:(dmode%,3)
  141.             else
  142.                 if dmode%=1 :rem level viewer
  143.                     if ev%(1)=290
  144.                         mINIT
  145.                         mCARD "File","New file",%n,"Open file",%o,"Play file",%P
  146.                         mCARD "Edit","Insert level",%i,"Append level",%a,"Merge level",%m,"Duplicate level",%d,"Move level to",%s
  147.                         mCARD "Multiple","Insert levels",%I,"Append levels",%A,"Duplicate levels",%D
  148.                         mCARD "Level","Parameters",%p,"Jump to",%j
  149.                         mCARD "Special","Exit",%x
  150.                         ev%(1)=MENU
  151.                     endif
  152.                     if ev%(1)>512
  153.                         ev%(1)=ev%(1)-512
  154.                     endif
  155.                     if ev%(2) and 2 and ev%(1)>=%a and ev%(1)<=%z
  156.                         ev%(1)=ev%(1)-32
  157.                     endif
  158.                     if ev%(1)=13
  159.                         dmode%=2
  160.                         diampos 2
  161.                         cx%=0
  162.                         cy%=0
  163.                         jx%=1
  164.                         jy%=1
  165.                         gcw%=24
  166.                         gch%=24
  167.                         smode%=1
  168.                         chg%=0
  169.                         statuswin off
  170.                         gSETWIN 0,0,480,160
  171.                         position cp%
  172.                         l$=a.layout$
  173.                         sx%=a.startx%
  174.                         sy%=a.starty%
  175.                         ex%=a.exit%
  176.                         if wv%
  177.                             gUSE disp%
  178.                             gSETWIN 299,54
  179.                             gvisible on
  180.                         endif
  181.                         gUSE 1
  182.                         update:(dmode%,3)
  183.                     elseif ev%(1)=%P
  184.                         play:(f$)
  185.                     elseif ev%(1)=%x
  186.                         close
  187.                         return
  188.                     elseif ev%(1)=%o
  189.                         f$="\app\stigma\*.lev"
  190.                         dINIT "Open file"
  191.                         dfile f$,"File:",72
  192.                         lock on
  193.                         d%=dialog
  194.                         lock off
  195.                         if d%
  196.                             close
  197.                             xopen:(f$)
  198.                             ep%=1
  199.                             cp%=1
  200.                             update:(1,3)
  201.                         endif
  202.                         elseif ev%(1)=%n
  203.                         f$="\app\stigma\*.lev"
  204.                         dINIT "New file"
  205.                         dfile f$,"File:",81
  206.                         lock on
  207.                         d%=dialog
  208.                         lock off
  209.                         if d%
  210.                             close
  211.                             xcreate:(f$)
  212.                             ep%=1
  213.                             cp%=1
  214.                             update:(1,3)
  215.                         endif
  216.                     elseif ev%(1)=%p
  217.                         position cp%
  218.                         t&=a.time%
  219.                         a=a.accel
  220.                         f=a.frict
  221.                         n$=a.code$
  222.                         dINIT "Level parameters"
  223.                         dEDIT n$,"Name"
  224.                         dLONG t&,"Timer",0,998
  225.                         dFLOAT a,"Accel",0,3
  226.                         dFLOAT f,"Frict",0,3
  227.                         lock on
  228.                         d%=dialog
  229.                         lock off
  230.                         if d%
  231.                             a.time%=t&
  232.                             a.accel=a
  233.                             a.frict=f
  234.                             a.code$=n$
  235.                             update
  236.                             churn:(0,cp%)
  237.                             update:(1,cp%-ep%+1)
  238.                         endif
  239.                     elseif ev%(1)=%m :rem merge
  240.                         f2$="\app\stigma\*.lev"
  241.                         t%=2
  242.                         dINIT "Open file"
  243.                         dfile f2$,"File:",72
  244.                         dCHOICE t%,"Levels:","One,All"
  245.                         lock on
  246.                         d%=dialog
  247.                         lock off
  248.                         if d%
  249.                             open f2$,B,layout$,code$,time%,startx%,starty%,frict,accel,exit%
  250.                             if t%=1
  251.                                 t&=1
  252.                                 dINIT
  253.                                 dLONG t&,"Level:",1,count
  254.                                 lock on
  255.                                 dialog
  256.                                 lock off
  257.                                 t%=t&
  258.                             else
  259.                                 t%=0
  260.                             endif
  261.                             if t%=0 :rem all levels
  262.                                 use A
  263.                                 t&=count
  264.                                 use B
  265.                                 t%=count
  266.                                 do
  267.                                     A.layout$=B.layout$
  268.                                     A.code$=B.code$
  269.                                     A.time%=B.time%
  270.                                     A.startx%=B.startx%
  271.                                     A.starty%=B.starty%
  272.                                     A.frict=B.frict
  273.                                     A.accel=B.accel
  274.                                     A.exit%=B.exit%
  275.                                     use A
  276.                                     append
  277.                                     use B
  278.                                     next
  279.                                     t%=t%-1
  280.                                 until t%=0
  281.                                 use A
  282.                                 t%=t&-cp%+1
  283.                                 churn:(t%,cp%)
  284.                             else :rem just level t%
  285.                                 use B
  286.                                 position t%
  287.                                 A.layout$=B.layout$
  288.                                 A.code$=B.code$
  289.                                 A.time%=B.time%
  290.                                 A.startx%=B.startx%
  291.                                 A.starty%=B.starty%
  292.                                 A.frict=B.frict
  293.                                 A.accel=B.accel
  294.                                 A.exit%=B.exit%
  295.                                 use A
  296.                                 append
  297.                                 churn:(0,cp%)
  298.                             endif
  299.                             use B
  300.                             close
  301.                             use A
  302.                             update:(1,3)
  303.                         endif
  304.                     elseif ev%(1)=%s :rem shift level1
  305.                         t&=cp%
  306.                         dINIT "Move level"
  307.                         dLONG t&,"New position:",1,count
  308.                         lock on
  309.                         d%=dialog
  310.                         lock off
  311.                         if d%
  312.                             position cp%
  313.                             update
  314.                             cp%=t&
  315.                             churn:(0,cp%)
  316.                             if cp%<count
  317.                                 ep%=cp%
  318.                             else
  319.                                 ep%=cp%-1
  320.                             endif
  321.                             update:(1,3)
  322.                         endif
  323.                     elseif ev%(1)=%j :rem jump to
  324.                         t&=cp%
  325.                         dINIT "Jump to level"
  326.                         dLONG t&,"Level",1,count
  327.                         lock on
  328.                         d%=dialog
  329.                         lock off
  330.                         if d%
  331.                             cp%=t&
  332.                             if cp%=count
  333.                                 ep%=cp%-1
  334.                             else
  335.                                 ep%=cp%
  336.                             endif
  337.                             update:(1,3)
  338.                         endif
  339.                     elseif ev%(1)=%d :rem duplicate
  340.                         position cp%
  341.                         append
  342.                         churn:(0,cp%)
  343.                         cp%=cp%+1
  344.                         if ep%<cp%-1
  345.                             ep%=ep%+1
  346.                         endif
  347.                         update:(1,3)
  348.                     elseif ev%(1)=%D :rem duplicate multi
  349.                         d%=multi%:("Duplicate")
  350.                         t%=count-cp%+1
  351.                         do
  352.                             position cp%
  353.                             append
  354.                             d%=d%-1
  355.                         until d%<1
  356.                         churn:(t%,cp%)
  357.                         update:(1,3)
  358.                     elseif ev%(1)=%i :rem insert
  359.                         blank:
  360.                         append
  361.                         churn:(0,cp%)
  362.                         update:(1,3)
  363.                     elseif ev%(1)=%I :rem insert multi
  364.                         d%=multi%:("Insert")
  365.                         t%=count-cp%+1
  366.                         blank:
  367.                         do
  368.                             append
  369.                             d%=d%-1
  370.                         until d%<1
  371.                         churn:(t%,cp%)
  372.                         update:(1,3)
  373.                     elseif ev%(1)=%a :rem append
  374.                         blank:
  375.                         append
  376.                         cp%=count
  377.                         ep%=cp%-1
  378.                         update:(1,3)
  379.                     elseif ev%(1)=%A :rem append multi
  380.                         d%=multi%:("Append")
  381.                         blank:
  382.                         do
  383.                             append
  384.                             d%=d%-1
  385.                         until d%<1
  386.                         cp%=count
  387.                         ep%=cp%-1
  388.                         update:(1,3)
  389.                     elseif ev%(1)=8 :rem delete
  390.                         position cp%
  391.                         if count=1
  392.                             giprint "Can't delete last level!"
  393.                         else
  394.                             dINIT "Delete level "+a.code$+"?"
  395.                             dBUTTONS "No",%N,"Yes",%y
  396.                             lock on
  397.                             d%=dialog
  398.                             lock off
  399.                             if d%=%y
  400.                                 erase
  401.                                 ep%=min(ep%,max(count-1,1))
  402.                                 cp%=min(cp%,count)
  403.                                 update:(1,3)
  404.                             endif
  405.                         endif
  406.                     elseif ev%(1)=257 :rem down
  407.                         if ev%(2) and 2
  408.                             if cp%<count
  409.                                 position cp%
  410.                                 update
  411.                                 cp%=cp%+1
  412.                                 churn:(0,cp%)
  413.                                 if cp%>ep%+1
  414.                                     ep%=ep%+1
  415.                                 endif
  416.                                 update:(1,3)
  417.                             endif
  418.                         else
  419.                             cp%=min(cp%+1,count)
  420.                             if cp%>ep%+1
  421.                                 ep%=ep%+1
  422.                                 gSCROLL 0,-80
  423.                                 update:(1,2)
  424.                             endif
  425.                         endif
  426.                     elseif ev%(1)=256 :rem up
  427.                         if ev%(2) and 2
  428.                             if cp%>1
  429.                                 position cp%
  430.                                 update
  431.                                 cp%=cp%-1
  432.                                 churn:(0,cp%)
  433.                                 if cp%<ep%
  434.                                     ep%=cp%
  435.                                 endif
  436.                                 update:(1,3)
  437.                             endif
  438.                         else
  439.                             cp%=max(cp%-1,1)
  440.                             if cp%<ep%
  441.                                 ep%=ep%-1
  442.                                 gSCROLL 0,80
  443.                                 update:(1,1)
  444.                             endif
  445.                         endif
  446.                     elseif ev%(1)=260 :rem PgUp
  447.                         cp%=max(cp%-10,1)
  448.                         ep%=cp%
  449.                         update:(1,3)
  450.                     elseif ev%(1)=261 :rem PgDn
  451.                         cp%=min(cp%+10,count)
  452.                         ep%=cp%-1
  453.                         update:(1,3)
  454.                     elseif ev%(1)=262 :rem home
  455.                         ep%=1
  456.                         cp%=1
  457.                         update:(1,3)
  458.                     elseif ev%(1)=263 :rem end
  459.                         ep%=count-1
  460.                         cp%=count
  461.                         update:(1,3)
  462.                     endif
  463.                 else :rem editor
  464.                     if ev%(1)=290
  465.                         mINIT
  466.                         mCARD "Layout","Revert",%v,"Fill with tile",%f
  467.                         mCARD "Tile","Get current",%g,"Toggle tile display",%w
  468.                         mCARD "Level","Place start",%s,"Place exit",%e,"Next",%n,"Previous",%p,"Jump to",%j
  469.                         ev%(1)=MENU
  470.                     endif
  471.                     if ev%(1)>512
  472.                         ev%(1)=ev%(1)-512
  473.                     endif
  474.                     if ev%(2) and 2 and ev%(1)>=%a and ev%(1)<=%z
  475.                         ev%(1)=ev%(1)-32
  476.                     endif
  477.                     if ev%(1)=%v
  478.                         position cp%
  479.                         l$=a.layout$
  480.                         sx%=a.startx%
  481.                         sy%=a.starty%
  482.                         ex%=a.exit%
  483.                         chg%=0
  484.                         update:(2,2)
  485.                     elseif ev%(1)=%n or ev%(1)=%p or ev%(1)=%j
  486.                         if chg%
  487.                             a.layout$=l$
  488.                             a.startx%=sx%
  489.                             a.starty%=sy%
  490.                             a.exit%=ex%
  491.                             update
  492.                             churn:(0,cp%)
  493.                         endif
  494.                         if ev%(1)=%n
  495.                             cp%=min(cp%+1,count)
  496.                             if ep%<cp%-1
  497.                                 ep%=ep%+1
  498.                             endif
  499.                         elseif ev%(1)=%p
  500.                             cp%=max(cp%-1,1)
  501.                             if cp%<ep%
  502.                                 ep%=cp%
  503.                             endif
  504.                         else
  505.                             t&=cp%
  506.                             dINIT "Jump to level"
  507.                             dLONG t&,"Level",1,count
  508.                             lock on
  509.                             d%=dialog
  510.                             lock off
  511.                             if d%
  512.                                 cp%=t&
  513.                                 if cp%=count
  514.                                     ep%=cp%-1
  515.                                 else
  516.                                     ep%=cp%
  517.                                 endif
  518.                             endif
  519.                         endif
  520.                         chg%=0
  521.                         position cp%
  522.                         l$=a.layout$
  523.                         sx%=a.startx%
  524.                         sy%=a.starty%
  525.                         ex%=a.exit%
  526.                         update:(2,2)
  527.                     elseif ev%(1)=%s
  528.                         smode%=2
  529.                         cx%=sx%
  530.                         cy%=sy%
  531.                         jx%=1
  532.                         jy%=1
  533.                         gcw%=24
  534.                         gch%=24
  535.                         giprint ""
  536.                         busy "Placing start"+chr$(1)
  537.                     elseif ev%(1)=%e
  538.                         smode%=3
  539.                         cy%=ex%/20
  540.                         cx%=ex%-cy%*20
  541.                         jx%=1
  542.                         jy%=1
  543.                         gcw%=24
  544.                         gch%=24
  545.                         giprint ""
  546.                         busy "Placing exit"+chr$(1)
  547.                     elseif ev%(1)=27
  548.                         busy off
  549.                         smode%=1
  550.                     elseif ev%(1)=%f
  551.                         l$=rept$(chr$(34+tle%),120)
  552.                         update:(2,2)
  553.                         chg%=1
  554.                     elseif ev%(1)=%w
  555.                         wv%=1-wv%
  556.                         gUSE disp%
  557.                         if wv%=1
  558.                             gVISIBLE ON
  559.                         else
  560.                             gVISIBLE OFF
  561.                         endif
  562.                         gUSE 1
  563.                     elseif ev%(1)=9
  564.                         tle%=pickt%:
  565.                         update:(2,1)
  566.                     elseif ev%(1)=%g
  567.                         tle%=asc(mid$(l$,cx%+cy%*20+1,1))-34
  568.                         update:(2,1)
  569.                     elseif ev%(1)=256 :rem up
  570.                         if ev%(2) and 4
  571.                             tle%=min(tle%+1,60)
  572.                             update:(2,1)
  573.                         else
  574.                             if ev%(2) and 2
  575.                                 jy%=max(1,jy%-1)
  576.                                 gch%=jy%*24
  577.                             else
  578.                                 cy%=max(cy%-1,0)
  579.                             endif
  580.                         endif
  581.                     elseif ev%(1)=257 :rem down
  582.                         if ev%(2) and 4
  583.                             tle%=max(tle%-1,1)
  584.                             update:(2,1)
  585.                         else
  586.                             if ev%(2) and 2
  587.                                 jy%=min(6-cy%,jy%+1)
  588.                                 gch%=jy%*24
  589.                             else
  590.                                 cy%=min(cy%+1,6-jy%)
  591.                             endif
  592.                         endif
  593.                     elseif ev%(1)=258 :rem right
  594.                         if ev%(2) and 4
  595.                             tle%=min(tle%+1,60)
  596.                             update:(2,1)
  597.                         else
  598.                             if ev%(2) and 2
  599.                                 jx%=min(20-cx%,jx%+1,10)
  600.                                 gcw%=jx%*24
  601.                             else
  602.                                 cx%=min(cx%+1,20-jx%)
  603.                             endif
  604.                         endif
  605.                     elseif ev%(1)=259 :rem left
  606.                         if ev%(2) and 4
  607.                             tle%=max(tle%-1,1)
  608.                             update:(2,1)
  609.                         else
  610.                             if ev%(2) and 2
  611.                                 jx%=max(1,jx%-1)
  612.                                 gcw%=jx%*24
  613.                             else
  614.                                 cx%=max(cx%-1,0)
  615.                             endif
  616.                         endif
  617.                     elseif ev%(1)=260 :rem PgUp
  618.                         cy%=0
  619.                     elseif ev%(1)=261 :rem PgDn
  620.                         cy%=6-jy%
  621.                     elseif ev%(1)=262 :rem Home
  622.                         cx%=0
  623.                     elseif ev%(1)=263 :rem End
  624.                         cx%=20-jx%
  625.                     elseif ev%(1)=13 or ev%(1)=32
  626.                         if smode%=1
  627.                             l$=ins$:(l$,cx%,cy%,jx%,jy%,tle%)
  628.                         elseif smode%=2
  629.                             sx%=cx%
  630.                             sy%=cy%
  631.                             smode%=1
  632.                             busy off
  633.                             giprint "Placed start",1
  634.                         elseif smode%=3
  635.                             ex%=cx%+20*cy%
  636.                             smode%=1
  637.                             busy off
  638.                             giprint "Placed exit",1
  639.                         endif
  640.                         chg%=1
  641.                     endif
  642.                     gUSE disp%
  643.                     if cx%<10
  644.                         gSETWIN 299,54
  645.                     else
  646.                         gSETWIN 59,54
  647.                     endif
  648.                     gUSE 1
  649.                     gAT 372,158
  650.                     gprintb id$(asc(mid$(l$,cx%+cy%*20+1,1))-34),108,1
  651.                 endif
  652.             endif
  653.             if dmode%=1
  654.                 if cp%=ep%+1
  655.                     gcy%=84
  656.                 else
  657.                     gcy%=4
  658.                 endif
  659.             else
  660.                 gcx%=cx%*24
  661.                 gcy%=cy%*24
  662.             endif
  663.         endif
  664.     until 0
  665. ENDP
  666.  
  667. PROC xopen:(file$)
  668.     open file$,A,layout$,code$,time%,startx%,starty%,frict,accel,exit%
  669.     setname file$
  670. ENDP
  671.  
  672. PROC xcreate:(file$)
  673.     trap delete file$
  674.     create file$,A,layout$,code$,time%,startx%,starty%,frict,accel,exit%
  675.     blank:
  676.     append
  677.     setname file$
  678. ENDP
  679.  
  680. PROC draw:(pic%)
  681.     LOCAL picX%,picY%,temp%
  682.     temp%=pic%-1
  683.     picY%=INT(temp%/20)
  684.     picX%=temp%-picY%*20
  685.     picX%=picX%*24
  686.     picY%=picY%*24
  687.     gCOPY graphic%,picX%,picY%,24,24,3
  688. ENDP
  689.  
  690. PROC drawlev:(lev$,xb%,yb%)
  691.     local dx%,dy%,ctr%,tile%,sy%,sx%
  692.     dx%=0
  693.     dy%=0
  694.     ctr%=1
  695.     DO
  696.         gAT dx%+xb%,dy%+yb%
  697.         tile%=ASC(MID$(lev$,ctr%,1))-35
  698.         sy%=INT(tile%/20)
  699.         sx%=tile%-sy%*20
  700.         gCOPY graphic%,sx%*12,sy%*12+119,12,12,3
  701.         dx%=dx%+12
  702.         IF dx%>228
  703.             dx%=0
  704.             dy%=dy%+12
  705.         ENDIF
  706.         ctr%=ctr%+1
  707.     UNTIL ctr%=121
  708. ENDP
  709.  
  710. PROC churn:(ka%,v%)
  711.     local k%
  712.     k%=ka%
  713.     if k%=0
  714.         k%=count-v%
  715.     endif
  716.     busy "Churning file"+chr$(1),1,3
  717.     while k%>0
  718.         position v%
  719.         update
  720.         k%=k%-1
  721.     endwh
  722.     busy off
  723. ENDP
  724.  
  725. PROC update:(m%,k%)
  726.     gUPDATE OFF
  727.     if k%=3
  728.         gCLS
  729.     endif
  730.     if m%=1
  731.         if k% and 1
  732.             slev:(ep%,0)
  733.         endif
  734.         if k% and 2
  735.             slev:(ep%+1,1)
  736.         endif
  737.     else
  738.         if k% and 1
  739.             position cp%
  740.             gUSE disp%
  741.             gAT 49,7
  742.             draw:(tle%)
  743.             gAT 7,42
  744.             gprintb id$(tle%),108,3
  745.             gUSE 1
  746.         endif
  747.         if k% and 2
  748.             gAT 0,144
  749.             gFILL 480,16,1
  750.             position cp%
  751.             gAT 0,158
  752.             gPRINT cp%,a.code$,"T";a.time%,"A";a.accel,"F";a.frict
  753.             llev:
  754.             gAT 372,158
  755.             gprintb id$(asc(mid$(l$,cx%+cy%*20+1,1))-34),108,1
  756.         endif
  757.     endif
  758.     gUPDATE ON
  759. ENDP
  760.  
  761. PROC slev:(lev%,pos%)
  762.     global ay%
  763.     ay%=pos%*80
  764.     if lev%>count
  765.         gAT 0,ay%
  766.         gFILL 416,80,1
  767.     else
  768.         position lev%
  769.         gtxt:(gen$(lev%,3)+": "+a.code$,0)
  770.         gtxt:("Timer: "+gen$(a.time%,3),1)
  771.         gtxt:("Accel: "+gen$(a.accel,5),2)
  772.         gtxt:("Friction: "+gen$(a.frict,5),3)
  773.         drawlev:(a.layout$,176,ay%+4)
  774.     endif
  775. ENDP
  776.  
  777. PROC gtxt:(v$,y%)
  778.     local x%
  779.     x%=gTWIDTH(v$)
  780.     gAT 0,y%*15+ay%+23-13
  781.     gFILL 176,13,1
  782.     gAT 88-x%/2,y%*15+ay%+23
  783.     gPRINT v$
  784. ENDP
  785.  
  786. PROC llev:
  787.     LOCAL ctr%,wkx%,wky%,glyph%
  788.     ctr%=1
  789.     wkx%=0
  790.     wky%=0
  791.     DO
  792.         glyph%=ASC(MID$(l$,ctr%,1))-34
  793.         gAT wkx%*24,wky%*24
  794.         Draw:(glyph%)
  795.         wkx%=wkx%+1
  796.         IF wkx%>19
  797.             wkx%=0
  798.             wky%=wky%+1
  799.         ENDIF
  800.         ctr%=ctr%+1
  801.     UNTIL ctr%=121
  802. ENDP
  803.  
  804. PROC ins$:(a$,x%,y%,vx%,vy%,v%)
  805.     local d%,k$(120),tx%,ty%
  806.     k$=a$
  807.     tx%=x%
  808.     do
  809.         ty%=y%
  810.         do
  811.             gAT tx%*24,ty%*24
  812.             draw:(v%)
  813.             d%=tx%+ty%*20+1
  814.             k$=left$(k$,d%-1)+chr$(v%+34)+mid$(k$,d%+1,120)
  815.             ty%=ty%+1
  816.         until ty%>y%+vy%-1
  817.         tx%=tx%+1
  818.     until tx%>x%+vx%-1
  819.     return k$
  820. ENDP
  821.  
  822. PROC setpick:
  823.     local t%,x%,y%
  824.     if gw%=0
  825.         gw%=gCREATE(54,26,372,108,0,1)
  826.         gXBORDER 1,$403
  827.         t%=1
  828.         y%=0
  829.         do
  830.             x%=0
  831.             do
  832.                 gAT x%*24+6,y%*24+6
  833.                 draw:(t%)
  834.                 t%=t%+1
  835.                 x%=x%+1
  836.             until x%=15
  837.         y%=y%+1
  838.         until y%=4
  839.     gUSE 1
  840.     endif
  841. ENDP
  842.  
  843. PROC pickt%:
  844.     local t%,x%,y%,k%
  845.     lock on
  846.     gUSE gw%
  847.     gVISIBLE ON
  848.     t%=tle%
  849.     y%=(t%-1)/15
  850.     x%=t%-(y%*15)-1
  851.     cursor gw%,0,24,24
  852.     do
  853.         gAT x%*24+6,y%*24+6
  854.         k%=get
  855.         if k%=256
  856.             y%=max(y%-1,0)
  857.         elseif k%=257
  858.             y%=min(y%+1,3)
  859.         elseif k%=258
  860.             x%=min(x%+1,14)
  861.         elseif k%=259
  862.             x%=max(x%-1,0)
  863.         elseif k%=260
  864.             y%=0
  865.         elseif k%=261
  866.             y%=3
  867.         elseif k%=262
  868.             x%=0
  869.         elseif k%=263
  870.             x%=14
  871.         endif
  872.         t%=x%+y%*15+1
  873.         giprint id$(t%)
  874.     until k%=27 or k%=9 or k%=32 or k%=13
  875.     cursor off
  876.     gVISIBLE OFF
  877.     gUSE 1
  878.     lock off
  879.     return t%
  880. ENDP
  881.  
  882. PROC blank:
  883.     a.layout$="&"+rept$(chr$(35),119)
  884.     a.code$="Blank"
  885.     a.time%=350
  886.     a.startx%=0
  887.     a.starty%=0
  888.     a.accel=.59
  889.     a.frict=.18
  890.     a.exit%=0
  891. ENDP
  892.  
  893. PROC multi%:(p$)
  894.     local k&,k%
  895.     k&=1
  896.     dINIT p$+" levels"
  897.     dLONG k&,"Number:",1,100
  898.     dialog
  899.     k%=k&
  900.     return k%
  901. ENDP
  902.  
  903. PROC setstr:
  904.     id$(1)="Clear"
  905.     id$(2)="Ex wall "+chr$(27)+chr$(26)
  906.     id$(3)="Ex wall "+chr$(24)+chr$(25)
  907.     id$(4)="Orb"
  908.     id$(5)="Space"
  909.     id$(6)="Ice"
  910.     id$(7)="Mud"
  911.     id$(8)="Rubber"
  912.     id$(9)="Wall "+chr$(27)+chr$(26)
  913.     id$(10)="Wall "+chr$(24)+chr$(25)
  914.     id$(11)="Wall "+chr$(25)+chr$(26)
  915.     id$(12)="Wall "+chr$(27)+chr$(25)
  916.     id$(13)="Wall "+chr$(24)+chr$(26)
  917.     id$(14)="Wall "+chr$(27)+chr$(24)
  918.     id$(15)="Wall "+chr$(27)+chr$(25)+chr$(26)
  919.     id$(16)="Wall "+chr$(27)+chr$(24)+chr$(26)
  920.     id$(17)="Wall "+chr$(27)+chr$(24)+chr$(25)
  921.     id$(18)="Wall "+chr$(24)+chr$(25)+chr$(26)
  922.     id$(19)="Wall "+chr$(24)
  923.     id$(20)="Wall "+chr$(25)
  924.     id$(21)="Wall "+chr$(27)
  925.     id$(22)="Wall "+chr$(26)
  926.     id$(23)="Cracked wall "+chr$(27)+chr$(26)
  927.     id$(24)="Cracked wall "+chr$(24)+chr$(25)
  928.     id$(25)="Arrow "+chr$(27)
  929.     id$(26)="Arrow "+chr$(26)
  930.     id$(27)="Arrow "+chr$(24)
  931.     id$(28)="Arrow "+chr$(25)
  932.     id$(29)="Rebounder"
  933.     id$(30)="Wall zapper"
  934.     id$(31)="Cracked tower"
  935.     id$(32)="Ex tower"
  936.     id$(33)="Tower"
  937.     id$(34)="Attractor "+chr$(27)
  938.     id$(35)="Attractor "+chr$(26)
  939.     id$(36)="Attractor "+chr$(24)
  940.     id$(37)="Attractor "+chr$(25)
  941.     id$(38)="Magnet"
  942.     id$(39)="Attractor "+chr$(24)+chr$(27)
  943.     id$(40)="Attractor "+chr$(24)+chr$(26)
  944.     id$(41)="Attractor "+chr$(25)+chr$(27)
  945.     id$(42)="Attractor "+chr$(25)+chr$(26)
  946.     id$(43)="Studded"
  947.     id$(44)="Door switch"
  948.     id$(45)="Key"
  949.     id$(46)="Locked door "+chr$(24)+chr$(25)
  950.     id$(47)="Locked door "+chr$(27)+chr$(26)
  951.     id$(48)="Open door "+chr$(24)+chr$(25)
  952.     id$(49)="Open door "+chr$(27)+chr$(26)
  953.     id$(50)="Teleport"
  954.     id$(51)="Spiked wall"
  955.     id$(52)="Cracked tile"
  956.     id$(53)="Grating"
  957.     id$(54)="Pseudo-exit"
  958.     id$(55)="Exit"
  959.     id$(56)="Skull"
  960.     id$(57)="1-way door "+chr$(25)
  961.     id$(58)="1-way door "+chr$(24)
  962.     id$(59)="1-way door "+chr$(27)
  963.     id$(60)="1-way door "+chr$(26)
  964. ENDP
  965.  
  966. PROC play:(f$)
  967.     local b$(20),d%
  968.     local c$(30),rec$(40),hi$(40),wk$(30),fn$(8)
  969.     local b%,c%,i%,pid%,v%(6)
  970.     lock on
  971.     close
  972.     trap mkdir "\app\stigma"
  973.     parse$(f$,"",v%())
  974.     wk$=mid$(f$,v%(1),v%(4)-v%(1))
  975.     fn$=mid$(f$,v%(4),v%(5)-v%(4))
  976.     rem locate stigma resources
  977.     if comm%=1
  978.         rec$="m:\gpk\"
  979.         hi$="m:\gpk\"
  980.     else
  981.         rec$="\"
  982.         hi$="m:\"
  983.     endif
  984.     trap mkdir rec$
  985.     trap mkdir hi$
  986.     rem if not exist original, copy stigma to original (hi/rec too)
  987.     if not exist("\app\stigma\original.lev")
  988.         copy tg$+"stigma.lev","\app\stigma\original.lev"
  989.         trap copy rec$+"stigma.rec","\app\stigma\original.rec"
  990.         trap copy hi$+"stigma.hi","\app\stigma\stigma.hi"
  991.     endif
  992.     rem get filename
  993.     rem copy level file
  994.     copy f$,tg$+"stigma.lev"
  995.     rem copy *.hi, *.rec
  996.     if exist (wk$+fn$+".hi")
  997.         copy wk$+fn$+".hi",hi$+"stigma.hi"
  998.     else
  999.         trap delete hi$+"stigma.hi"
  1000.     endif
  1001.     if exist (wk$+fn$+".rec")
  1002.         copy wk$+fn$+".rec",rec$+"stigma.rec"
  1003.     else
  1004.         trap delete rec$+"stigma.rec"
  1005.     endif
  1006.     rem launch stigma
  1007.     i%=addr(pid%)
  1008.     b%=addr(b$)+1
  1009.     c%=addr(c$)
  1010.     rem stigma_s.gam, stigma.app
  1011.     b$="ROM::sys$prgo"+chr$(0)
  1012.     if comm%
  1013.         c$="RunOpl"+rept$(chr$(0),2)+dr$+":\app\stigma.app"+chr$(0)
  1014.     else
  1015.         c$="RunOpl"+rept$(chr$(0),2)+dr$+":\app\stigma_s.gam"+chr$(0)
  1016.     endif
  1017.     call($0187,b%,c%,d%,0,i%)
  1018.     call($0688,pid%)
  1019.     rem wait
  1020.     v%(6)=0
  1021.     do
  1022.         getevent v%()
  1023.         if v%(1)=$401
  1024.             v%(2)=call($0288,pid%)
  1025.             if (v%(2) and 255)<>$70
  1026.                 v%(6)=1
  1027.             else
  1028.                 call($998d,0,pid%)
  1029.             endif
  1030.         endif
  1031.     until v%(6)=1
  1032.     rem copy back
  1033.     copy rec$+"stigma.rec",wk$+fn$+".rec"
  1034.     copy hi$+"stigma.hi",wk$+fn$+".hi"
  1035.     xopen:(f$)
  1036.     lock off
  1037. ENDP
  1038.  
  1039. PROC callme:(v$)
  1040.     local k$(9),m%
  1041.     pid%=call($88)
  1042.     k$=v$+chr$(0)
  1043.     m%=addr(k$)+1
  1044.     call($c88,pid%,0,0,0,m%)
  1045. ENDP
  1046.