home *** CD-ROM | disk | FTP | other *** search
/ Magazyn Amiga Shareware Floppies / ma68.dms / ma68.adf / K-WindowS_09B / Misc / Source / K-WindowS.ASCII next >
Text File  |  1996-08-12  |  12KB  |  448 lines
  1.  
  2.  
  3. ; BBB  L    III TTTTT ZZZZZ
  4. ; B  B L     I    T      Z
  5. ; BBB  L     I    T     Z
  6. ; B  B L     I    T    Z
  7. ; BBB  LLLL III   T   ZZZZZ  Basic II   is simply the BEST.   :-)
  8.  
  9.  
  10. WBStartup:NoCli:SetErr:End:End SetErr
  11.  
  12. Version.s="$VER:K-WindowS 0.9B / Aout 1996"   :Version=UnRight$(Version,5)
  13.  
  14. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  15. ; Ecrit en Blitz Basic. The Best.
  16. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  17. ; Ecrit par Gabriel Klein
  18. ;           En Princiau
  19. ;           1081 Montpreveyres
  20. ;           Suisse
  21. ;           BBS: 0041:(0)27 221 900. Pseudo: KGP
  22. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  23. ; Source de K-WindowS
  24. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  25. ; You can use some part of this source, but you can't redistribute
  26. ; it.
  27. ; If you have made some improvement. Send this new source on my BBS
  28. ; or by mail. I'll update the version string, and the About (for
  29. ; your name).
  30.  
  31. ; Vous pouver regardez dans cette source, prendre de PETITS
  32. ; bouts. Mais vous n'avez pas le droit de redistribuer une
  33. ; version... meme amelioree.
  34. ; Si vous faites une version meilleurs, envoyez-la moi et je
  35. ; m'occuperais de son numero de version, vous laisserais une
  36. ; place dans 'A Propos'.
  37. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  38. ; K-WindowS is MailWare. This Source is like K-WindowS... MailWare
  39. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  40. ; Interessting think are
  41. ;                      - Use of commodity
  42. ;                      - Use of Port for only 1 run.
  43. ;                      - Use of *Scree.Screen=...
  44. ;                        if you don't know this stucture
  45. ;                        try to understand it.
  46. ;                        Look in 'View NewType' menu
  47. ;                        Type in Screen.
  48. ; EX:  *Scree.Screen=ActiveScren  ; define struct '*Scree' address
  49. ;      *Scree\NextScreen give the next Screen Intuition Adress
  50. ;                      (You use a internal address style.
  51. ;                       You can have the Intuition addresse with
  52. ;                       Peek.l (Addr Screen (0)).
  53. ; Usefull if you want to use Amiga Libs ( ...._ style instructions )
  54.  
  55.  
  56.  
  57.  
  58. If IsReqToolsActive=False
  59.   If FromCLI
  60.     NPrint "":NPrint Version:NPrint "Need ReqTools.library (Nico Francois)":NPrint ""
  61.   Else
  62.     FindScreen 0:ScreensBitMap 0,0:BitMapOutput 0
  63.     For ib.b=0 To 110
  64.       Locate ib,0
  65.       Print " K-WindowS need ReqTools. Sorry."
  66.       VWait 4
  67.     Next
  68.   EndIf
  69.   End
  70. EndIf
  71.  
  72.  
  73.  
  74.  
  75.  
  76. NEWTYPE .Ferme:Sty.b:Mem.l:Nom.s:PosY.w:Scr.l:x1.w:y1.w:x3.w:y3.w:End NEWTYPE
  77. Dim CloseS.Ferme (120),ib.b(15)
  78. CloseS(0)\Sty=1:CloseS(0)\Nom="Workbench Screen"
  79. *Intui.IntuitionBase=IntuitionBase
  80.  
  81.  
  82. NEWTYPE .Prefs
  83.   WaitTime.w
  84.   WayIn.b
  85.   Pri.b
  86.   Key.s
  87. End NEWTYPE
  88. USEPATH Prefs.Prefs
  89.  
  90. Dim Mess.s(25)
  91.  
  92. Mess(15)="Error while running K-WindowS!"
  93. SetErr
  94.   If ILock.l<>0 Then UnlockIBase_(ILock):ILock=0
  95.   DisplayBeep_(ActiveScreen)
  96.   il.l=RTEZRequest(Version,Mess(15),"Sorry")
  97.   End
  98. End SetErr
  99.  
  100. If ReadFile(0,"K-WindowS.Txt")=False
  101.   il.l=RTEZRequest(Version,"Text file (K-WindowS.Txt) no found.","Quit")
  102.   End
  103. EndIf
  104. FileInput 0
  105. ib2.b=-1
  106.  
  107. Repeat
  108.   ib.b=-100
  109.   LoTx:
  110.   i$=Edit$(500)
  111.   If i$="" OR Left$(i$,1)=";"
  112.     ib.b+1
  113.     If ib>100 Then Pop Repeat:Goto TxLod
  114.     Goto LoTx
  115.   EndIf
  116.   ib.b=-100
  117.  
  118.   If Left$(i$,1)="*"
  119.     Poke.b &i$,10
  120.   Else
  121.     ib2.b+1
  122.     j$=""
  123.   EndIf
  124.   j$+i$
  125.   Mess(ib2)=j$
  126. Until ib>22
  127.  
  128. TxLod:
  129.  
  130. CloseFile 0
  131.  
  132. \WaitTime=Val(Mess(18))
  133. \WayIn=Val(Mess(19))
  134. \Key=Mess(20)
  135. \Pri=Val(Mess(20))
  136.  
  137. If \WayIn=1
  138.   com:
  139.   If MakeCommodity("K-WindowS",Version,"C-Gabriel Klein, MailWare.")=False
  140.     DisplayBeep_(ActiveScreen)
  141.     End
  142.   EndIf
  143.   com2:
  144.   If SetHotKey(0,\Key)=False
  145.     il.l=RTEZRequest(Version,"Can't create HotKey","Retry|Change|Quit")
  146.     If il=0 Then End Else Goto com2
  147.     If il=2 Then \Key=RTEZGetString(Version,"Choose HotKey...",\Key):Goto com2
  148.   EndIf
  149. EndIf
  150.  
  151. SetTaskPri_ FindTask_(0),\Pri
  152.  
  153. If FindPort_("KWindowS")<>0
  154.   il.l=RTEZRequest(Version,Mess(12),Mess(13))
  155.   If il=0 Then End
  156. EndIf
  157.  
  158. il.l=CreateMsgPort("KWindowS")
  159.  
  160. WbToScreen 0
  161. WorkBenchAddr.l=Peek.l(Addr Screen (0))
  162.  
  163.  
  164.  
  165. ;;;;;;;;;;;;;;;;;;;;;;;;;; Boucle Principal ;;;;;;;;;;;;;;;;;;;;
  166. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  167.  
  168. .Boucle
  169. If ILock<>0 Then UnlockIBase_(ILock):ILock=0
  170. .Boucle2
  171.   If \WaitTime>0 Then VWait \WaitTime
  172.   Select \WayIn
  173.    Case 0:If Joyb(0)=3 Then Goto SmeHasClick
  174.    Case 1
  175.      Wait
  176.      If CommodityEvent
  177.        il.l=ExchangeMessage
  178.        If il=0
  179.          Goto SmeHasClick
  180.        Else
  181.          Select il
  182.          Case CxAppear
  183.            Goto SmeHasClick
  184.          Case CxKill
  185.            End
  186.          End Select
  187.        EndIf
  188.      EndIf
  189.  
  190.  
  191.  
  192.  
  193.  
  194.  
  195.  
  196.  
  197.  
  198.  
  199.  
  200.  
  201.  
  202.  
  203.  
  204.   End Select
  205. Goto Boucle2
  206.  
  207.  
  208. .SmeHasClick
  209.   ActiveW.l=ActiveWindow
  210.   ActiveS.l=ActiveScreen
  211.   il.l=RTEZRequest(Version,Mess(16),Mess(17))
  212.   Choice.b=0
  213.   If il=0 Then Goto Boucle
  214.   If il=4
  215.     ill.l=RTEZRequest(Version,Mess(4),Mess(5))
  216.     Select ill
  217.      Case 1
  218.       End
  219.      Case 2
  220.       j$=Chr$(10)
  221.       i$=Version+j$+"C-1996 Gabriel Klein"+j$+j$+"MailWare"+j$+"If you use it..."+j$
  222.       i$+"Send a nice PostCard to"+j$+"Gabriel Klein"+j$+"En Princiau"+j$+"1081 Montpreveyres"+j$
  223.       i$+"SUISSE"+j$+j$+"You can distribut this file"+j$+"in an unchanged form EVERYWHERE"+j$
  224.       i$+j$+"May the AMIGA be with you forever."+j$+"Traitor are those who buy P.C."+j$
  225.       i$+"but there are no lawn to punnish these men."+j$+j$+"Langage: "+Mess(1)+" by "+Mess(0)
  226.       il=RTEZRequest(Version,i$,"I'm a fan of you.")
  227.       Goto Boucle
  228.      Case 3
  229.       il.l=10
  230.      Default
  231.       Goto Boucle
  232.     End Select
  233.   EndIf
  234.  
  235.   If il=10 Then Choice.b=1
  236.   If il=1 Then Choice=2
  237.   If il=2 Then Choice=3
  238.   If il=3 Then Choice=4
  239.  
  240.   On Choice Goto HardClose,EcranFerme,WinFerme,OuvreQQCH
  241.  
  242. Goto Boucle
  243.  
  244. .HardClose
  245.   il=RTEZRequest(Version,Mess(2),Mess(3))
  246.   If il>0 AND il <3Then *Windo.Window=ActiveW:ill.l=*Windo\Parent:If il>0 Then ActivateWindow_(ill):VWait 2
  247.   WbToScreen 0:WorkBenchAddr.l=Peek.l(Addr Screen (0))
  248.   If il>2 AND WorkBenchAddr=ActiveS Then CloseWorkBench_:Goto Boucle
  249.   If il=1
  250.     ill.l=WindowLimits_(ActiveW,1,1,1,1):VWait
  251.     *Windo.Window=ActiveW
  252.     *Windo\MinWidth=1
  253.     *Windo\MinHeight=1
  254.     *Windo\Width=1:*Windo\Height=1
  255.     *Windo\PtrWidth=1
  256.     *Windo\PtrHeight=1
  257.     *Windo\LeftEdge=0
  258.     *Windo\TopEdge=0
  259.     ill.l=SizeWindow_(ActiveW,-1,-1)
  260. ;    ILock.l=LockIBase_(0)
  261. ;    WindowToBack_(ActiveW)
  262. ;    NewWin.l=ActiveS+4
  263. ;    ib.b=-100
  264. ;    Repeat
  265. ;      OldWin.l=NewWin.l
  266. ;      NewWin.l=Peek.l(OldWin)
  267. ;      ib+1:If ib>100 OR NewWin=0 Then UnlockIBase_(ILock):ILock=0:Goto Boucle
  268. ;    Until NewWin=ActiveW
  269. ;    Poke.l OldWin,Peek.l(NewWin)
  270. ;    UnlockIBase_(ILock):ILock=0
  271.   EndIf
  272.   If il=2 Then CloseWindow_(ActiveW)
  273.   If il=3
  274.     Repeat
  275.       il.l=Peek.l(ActiveS+4)
  276.       If il=0 Then Pop Repeat:Goto CloseS1
  277.       CloseWindow_ (il)
  278.       VWait 5
  279.     Forever
  280.     CloseS1:
  281.     CloseScreen_ (ActiveS)
  282.   EndIf
  283.   If il=4
  284.     ill.l=MoveScreen_(ActiveS,0,5000)
  285.     ILock.l=LockIBase_(0)
  286.     ib.b=-100
  287.     *Intui.IntuitionBase=IntuitionBase
  288.     NewScr.l=&*Intui\FirstScreen
  289.     Repeat
  290.       OldScr.l=NewScr.l
  291.       NewScr=Peek.l(OldScr)
  292. ;     il.l=RTEZRequest(Str$(IntuitionBase)+"-"+Str$(Int_Base),Hex$(OldScr)+"-"+Hex$(ActiveS),Hex$(NewScr))
  293.       ib.b+1:If ib>100 OR OldScr=0 Then UnlockIBase_(ILock):ILock=0:il=MoveScreen_(ActiveS,0,-5000):Goto Boucle
  294.     Until NewScr=ActiveS
  295.     Poke.l OldScr,Peek.l(NewScr)
  296.     Poke.l ActiveS,0
  297.     *Intui\ActiveScreen=*Intui\FirstScreen
  298.     UnlockIBase_(ILock):ILock=0
  299.   EndIf
  300. Goto Boucle
  301.  
  302.  
  303. .EcranFerme
  304.   WbToScreen 0
  305.   WorkBenchAddr.l=Peek.l(Addr Screen (0))
  306.   If ActiveS=WorkBenchAddr Then CloseWorkBench_:Goto Boucle
  307.   ill.l=MoveScreen_(ActiveS,0,5000)
  308.   ILock.l=LockIBase_(0)
  309.   ib.b=-100
  310.   *Intui.IntuitionBase=IntuitionBase
  311.   NewScr.l=&*Intui\FirstScreen
  312.   Repeat
  313.     OldScr.l=NewScr.l
  314.     NewScr=Peek.l(OldScr)
  315. ;     il.l=RTEZRequest(Str$(IntuitionBase)+"-"+Str$(Int_Base),Hex$(OldScr)+"-"+Hex$(ActiveS),Hex$(NewScr))
  316.     ib.b+1:If ib>100 OR OldScr=0 Then UnlockIBase_(ILock):ILock=0:il=MoveScreen_(ActiveS,0,-5000):Goto Boucle
  317.   Until NewScr=ActiveS
  318.   Poke.l OldScr,Peek.l(NewScr)
  319.   Poke.l ActiveS,0
  320.   *Intui\ActiveScreen=*Intui\FirstScreen
  321.   UnlockIBase_(ILock):ILock=0
  322.   Gosub FirstFree
  323.   CloseS(cib.b)\Sty=1
  324.   CloseS(cib)\Mem=ActiveS
  325.   *Scree.Screen=ActiveS:CloseS(cib)\Nom=Peek$(*Scree\DefaultTitle)
  326.   Goto Boucle
  327. .WinFerme
  328.   If Peek.l(ActiveS+4)=0 Then DisplayBeep_(ActiveScreen):Goto Boucle
  329.   ILock.l=LockIBase_(0)
  330.   NewWin.l=Peek.l(ActiveS+4)
  331.   ib.b=-100
  332.   Repeat
  333.     OldWin.l=NewWin
  334.     NewWin=Peek.l(OldWin)
  335.     ib+1:If ib>100 Then UnlockIBase_(ILock):ILock=0:Goto Boucle
  336.   Until OldWin=ActiveW
  337.   Gosub FirstFree
  338.   *Windo.Window=ActiveW
  339.   CloseS(cib.b)\Scr=ActiveS
  340.   CloseS(cib)\x1=*Windo\Width
  341.   CloseS(cib)\y1=*Windo\Height
  342.   CloseS(cib)\x3=*Windo\MinWidth
  343.   CloseS(cib)\y3=*Windo\MinHeight
  344.   *Windo\MinWidth=1
  345.   *Windo\MinHeight=1
  346.   CloseS(cib)\Sty=2
  347.   CloseS(cib)\Mem=ActiveW
  348.   *Scree.Screen=ActiveS
  349.   CloseS(cib)\Nom=Peek$(*Windo\Title)+" ("+Left$(Peek$(*Scree\Title),10)+"...)"
  350.   UnlockIBase_(ILock):ILock=0
  351.   il.l=SizeWindow_(ActiveW,-*Windo\Width+1,-*Windo\Height+1)
  352.   VWait 5
  353.   If *Windo\Width>2 OR *Windo\Height>2 ;For think that doesn't want to get small
  354.     *Windo\MinWidth=CloseS(cib)\x3
  355.     *Windo\MinHeight=CloseS(cib)\y3
  356.     CloseS(cib)\Sty=0
  357.   EndIf
  358.   Goto Boucle
  359. .OuvreQQCH
  360. ib2.b=0
  361. Ouv2:
  362. i$=Mess(6)+Chr$(10)+Chr$(10):ibb.b=0:j$=""
  363. For ib.b=ib2 To 120
  364.   If CloseS(ib)\Sty>0
  365.     ibb+1
  366.     i$+Str$(ib)+": "
  367.     ib(ibb)=ib
  368.     If CloseS(ib)\Sty=1 Then i$+Mess(7)+" "
  369.     If CloseS(ib)\Sty=2 Then i$+Mess(8)+" "
  370.     i$+CloseS(ib)\Nom+Chr$(10)
  371.     j$+Str$(ib)+"|"
  372.     If ibb>9 Then ib2=ib:ib=121
  373.   EndIf
  374. Next
  375. If ibb>9 Then j$+Mess(9) Else j$+Mid$(Mess(9),1+Instr(Mess(9),"|"))
  376. il.l=RTEZRequest(Version,i$,j$)
  377. If il=0 Then Goto Boucle
  378. If il=11 Then Goto Ouv2
  379. Choix.b=ib(il)
  380.  
  381. If Choix=0 Then OpenWorkBench_:Goto Boucle
  382. If CloseS(Choix)\Sty=1
  383.   ILock.l=LockIBase_(0)
  384.   NewScr.l=&*Intui\FirstScreen
  385.   ib.b=0
  386.   Repeat
  387.     OldScr.l=NewScr.l
  388.     NewScr=Peek.l(OldScr)
  389.     ib.b+1:If ib>100 Then UnlockIBase_(ILock):ILock=0:DisplayBeep_(ActiveScreen):Pop If:Goto Boucle
  390.   Until NewScr=0
  391.   Poke.l OldScr,CloseS(Choix)\Mem
  392.   UnlockIBase_(ILock):ILock=0
  393.   VWait:il=MoveScreen_(CloseS(Choix)\Mem,0,-5000)
  394.   CloseS(Choix)\Sty=0
  395.   ScreenToFront_(CloseS(Choix)\Mem)
  396. EndIf
  397. If CloseS(Choix)\Sty=2
  398.   NewScr.l=*Intui\FirstScreen
  399.   ib.b=0
  400.   Repeat
  401.     OldScr.l=NewScr.l
  402.     NewScr=Peek.l(OldScr)
  403.     ib.b+1:If ib>100 Then DisplayBeep_(ActiveScreen):Pop If:Goto Boucle
  404.     If OldScr=0
  405.       il.l=RTEZRequest(Version,Mess(10),Mess(11))
  406.       If il=1 Then CloseS(Choix)\Sty=0
  407.       If il=2 Then Goto MeuhOui
  408.       Pop If:Pop Repeat:Pop If
  409.       Goto Boucle
  410.     EndIf
  411.   Until OldScr=CloseS(Choix)\Scr
  412.   MeuhOui:
  413.   NewWin.l=CloseS(Choix)\Mem
  414.   ib.b=0
  415.   Repeat
  416.     OldWin.l=NewWin.l
  417.     NewWin=Peek.l(OldWin)
  418.     ib.b+1:If ib>100 Then DisplayBeep_(ActiveScreen):Pop If:Goto Boucle
  419.     If OldWin=0
  420.       il.l=RTEZRequest(Version,Mess(14),Mess(11))
  421.       If il=1 Then CloseS(Choix)\Sty=0
  422.       If il=2 Then Goto MeuhOui2
  423.       Pop If:Pop Repeat:Pop If
  424.       Goto Boucle
  425.     EndIf
  426.   Until OldWin=CloseS(Choix)\Mem
  427.   MeuhOui2:
  428.   If ILock<>0 Then UnlockIBase_(ILock):ILock=0
  429.   *Windo=CloseS(Choix)\Mem
  430.   *Windo\MinWidth=CloseS(Choix)\x3
  431.   *Windo\MinHeight=CloseS(Choix)\y3
  432.   CloseS(Choix)\Sty=0
  433.   ill.l=SizeWindow_(CloseS(Choix)\Mem,CloseS(Choix)\x1-1,CloseS(Choix)\y1-1)
  434. EndIf
  435. Goto Boucle
  436.  
  437.  
  438. .FirstFree
  439.   For cib.b=1 To 120
  440.     If CloseS(cib)\Sty=0 Then Pop For:Goto Ret
  441.   Next
  442.   If ILock<>0 Then UnlockIBase_(ILock):ILock=0
  443.   il.l=RTEZRequest(Version,"Can't add more item.","Shit")
  444.   Pop Gosub
  445.   Goto Boucle
  446.   Ret:
  447. Return
  448.