' ***************************************************************************** ' ' M A L P R O G R A M M " K R I T Z E L " ' ' programmiert von Heiko Mller, Mozartstraže 17, 2905 Edewecht ' datum$="19.11.1991" ! letztes Bearbeitungsdatum version$="3.94" ! Version-Nummer ' ' ***************************************************************************** ' ' letzte Ver„nderungen: ' ' In den ersten Versionen dieses Programms wurde die GEM-Menleiste kombiniert ' mit Tastaturaufrufen (ON MENU gleichzeitig mit ON MENU KEY). ' Leider fhrte das zu Programmabstrzen mit Bildverlust, wenn man bei herun- ' tergeklapptem Men gleichzeitig eine Taste bet„tigte. Da dieser Fehler sich ' nicht beseitigen liež, wird ab der Version 3.5 ein "selbstgestricktes" Men ' eingesetzt (Funktion „hnlich D.R.A.W). ' ' ab Version 3.6 ist ein Titelbild in den Programmtext eingebunden (in der Pro- ' cedure "inlines_einlesen"). Wenn diese Programmliste mit Save,A abgespeichert ' wurde, muž das Titelbild wieder in die entsprechende INLINE-Zeile eingeladen ' werden. ' ' ab Version 3.7: ' Block-Stauchen und -Drehen ' Geodreieck ' Prisma und Pyramide ' Tortendiagramm wird als Block zum Einsetzen eingefangen ' Sprhen mit Muster ' Geraden, Kreise und K„sten mit zwei Mausklicks zeichnen ' Bezier-Kurve ' STAD-Bilder lassen sich laden (INLINE-Maschinenprogramm) ' verschiedene Ausdruckgr”žen m”glich ' ' ab Version 3.9: ' STAD-Bilder lassen sich speichern (INLINE-Maschinenprogramm) ' Uhr l„uft st„ndig im Men ' IMG-Format l„žt sich laden und speichern (INLINE-Maschinenprogramm) ' Hilfsbemerkungen ge„ndert ' SIGNUM-Fonts auch fr die anderen Aufl”sungen m”glich ' Zeigeruhr eingebaut ' Scan-Codes statt INKEY$ im Men verwendet ' M”glichkeit zur Untersuchung des Bootsektors; Mausvirus erkennen ' ' ################# nun geht's los: #################### ' DEFINT "a-z" DEFLIST 2 SETCOLOR 0,1 ! schwarz auf weiž ' $%0 ! Integerdivisionen mit Fliežkomma ausfhren $I+ ! Interrupt-Routinen einschalten (damit die Uhr st„ndig l„uft) $E+ $U+ ! hinter jedem Befehl C+S+A, EVERY und AFTER testen ' ON BREAK GOSUB schluss ON ERROR GOSUB fehler ' IF XBIOS(4)<>2 ALERT 3,"Dieses Programm l„uft leider|nur mit einem|Schwarzweiž-Monitor!",1,"Sch... ",dummy% EDIT ENDIF ' VOID XBIOS(33,4) ! Drucker auf 960 Punkte/Zeile einstellen SPOKE &H484,PEEK(&H484) AND NOT 2 ! Tastaturklickwiederholung aus SETCOLOR 0,1 ! schwarze Schrift auf weižem Grund ' CLS SGET bild$ ! vier leere Bilder einlesen und Platz fr Zweitschirm SGET undo$ ! schaffen, damit Speicherplatzprobleme gleich deutlich werden SGET block$ SGET merk$ @zweitschirm ' HIDEM @speicher_einrichten @inlines_einlesen IF LEFT$(pfad$,1)="A" virus!=FALSE @bootsektor(0) IF virus! EDIT ENDIF ENDIF @menue_einrichten @version IF RIGHT$(DATE$,6)=RIGHT$(erstelldatum$,6) @datum_und_uhr ! Falls der Computer keine eingebaute Uhr hat ENDIF ' ALERT 2,"Sollen Hilfsbemerkungen|eingeblendet werden?",2,"ja|nein",antw% IF antw%=1 hilfe!=TRUE ELSE hilfe!=FALSE ENDIF ' SHOWM DEFMOUSE 3 ' neustart: ! Marke wird evtl. nach Fehlern angesprungen bild$=bild$(bild%) ! das verlorene Bild wird wieder zurckgeholt ' DO ! ********************************** Hauptprogramm *********************** ' ########### ' ON BREAK ! einschalten beim Entwickeln des Programms ' ON ERROR ' ########### ' IF menue_aus! OR anzeige! EVERY STOP SPUT bild$ HIDEM ELSE EVERY 400 GOSUB uhr ! zeitanzeige SHOWM SPUT menue$ @uhr ! zeitanzeige GRAPHMODE 1 DEFTEXT 1,0,0,4 TEXT 5,48,"RAM: "+STR$(FRE(0)) ! freien Speicherplatz anzeigen TEXT 100,48,"TOS-Version "+tosversion$+" vom "+erstelldatum$ DEFMOUSE 3 ' ENDIF REPEAT ! Warteschleife mit Tastatur- oder Mausabfrage @get.tom UNTIL k% OR scan% ' IF k%=2 OR scan%=57 auswahl%=0 k%=0 scan%=0 anzeige!=NOT anzeige! ! statt Men wird Bild gezeigt @mauswarte ENDIF ' IF k%=1 OR scan% EVERY STOP IF k%=1 scan%=0 IF (NOT menue_aus!) AND (NOT anzeige!)! Mausauswahl nur mit sichtbarem Men auswahl%=INT(y%/50)*10+INT(x%/80) ENDIF ELSE auswahl%=0 IF (taste% AND 1)=1 OR (taste% AND 2)=2 ! Shift gehalten: +200 ADD scan%,200 ENDIF IF (taste% AND 4)=4 ! Control gehalten: +800 ADD scan%,800 ENDIF ENDIF ' SHOWM @abfrage ' ENDIF LOOP ' ' *1************************************************************************** ' PROCEDURE abfrage ' @mauswarte ' PAUSE 10 ! dadurch klingelt's nicht so leicht bei Alert bild$(bild%)=bild$ ! damit das Bild nach Fehlern gerettet ist ' SPOKE &H484,PEEK(&H484) OR 2 ! Tastaturklickwiederholung ein ' ' ########################## Zeilen zur Programmentwicklung einschalten: ' IF scan% OR auswahl%>0 ' ALERT 1,"Scancode: "+STR$(scan%)+"|Auswahl: "+STR$(auswahl%),1,"aha",dummy% ' Endif ' ########################## ' IF scan%=846 ! Programmabbruch mit Control+C m”glich @schluss ENDIF IF scan%=48 ! B @blockabfrage ENDIF IF scan%=32 ! D @dateiabfrage ENDIF IF auswahl%=10 OR scan%=26 ! š @ueber ENDIF IF auswahl%=11 OR scan%=1 ! Esc SPUT bild$ @accessory ENDIF IF auswahl%=12 OR scan%=425 ! Datei - P @speicherplatz ENDIF IF auswahl%=13 OR scan%=422 ! Datei - U @datum_und_uhr ENDIF IF auswahl%=14 OR scan%=438 ! Datei - L SPUT bild$ @laden SPUT bild$ @bild_kurz_zeigen(100000) ! zeigen, bis Taste oder Mausbewegung ENDIF IF auswahl%=15 OR scan%=431 ! Datei - S SPUT bild$ @speichern ENDIF IF auswahl%=16 OR scan%=483 ! Datei - Delete @datei_loeschen ENDIF IF auswahl%=17 OR scan%=424 ! Datei - O @neuer_ordner ENDIF IF auswahl%=20 OR scan%=75 OR scan%=77 ! Pfeiltasten links/rechts IF (k% AND x%>40) scan%=77 ENDIF IF (k% AND x%<41) scan%=75 ENDIF @bildwechsel(scan%) @menu_aendern SPUT bild$ ENDIF IF auswahl%=21 OR scan%=97 ! Undo SWAP bild$,undo$ SPUT bild$ @bild_kurz_zeigen(100) ENDIF IF auswahl%=22 OR scan%=83 ! Delete SPUT bild$ @loeschen ENDIF IF auswahl%=23 OR scan%=23 ! I SPUT bild$ @invert @bild_kurz_zeigen(100) ENDIF IF auswahl%=24 OR scan%=25 ! P SPUT bild$ @ausdruck ENDIF IF auswahl%=25 OR scan%=37 ! K SPUT bild$ @kopieren SPUT bild$ @bild_kurz_zeigen(100) ENDIF IF auswahl%=26 OR scan%=22 ! U SPUT bild$ @umriss SPUT bild$ @bild_kurz_zeigen(100) ENDIF IF auswahl%=27 OR scan%=24 ! O k%=0 SPUT bild$ IF menue_aus!=FALSE menue_aus!=TRUE ' al$="Nun geht's nur noch mit|Tastenaufrufen weiter.|" al$=al$+"Mit der Taste O wird das|Men wieder eingeschaltet." ALERT 1,al$,1,"aha",antw% ' ELSE menue_aus!=FALSE ENDIF ENDIF IF auswahl%=30 OR scan%=33!"F" SPUT bild$ @freihand ENDIF IF auswahl%=31 OR scan%=34 !"G" SPUT bild$ @gerade ENDIF IF auswahl%=32 OR scan%=38 !"L" SPUT bild$ @linienzug ENDIF IF auswahl%=33 OR scan%=102 !"*" SPUT bild$ @strahlen ENDIF IF auswahl%=34 OR scan%=19 !"R" SPUT bild$ @radiergummi ENDIF IF auswahl%=35 OR scan%=31 !"S" SPUT bild$ @spruehdose ENDIF IF auswahl%=36 OR scan%=50 !"M" SPUT bild$ @mikroskop ENDIF IF auswahl%=37 OR scan%=30 !"A" SPUT bild$ @fuellen ENDIF IF auswahl%=40 OR scan%=59 ! F1 SPUT bild$ @kreis ENDIF IF auswahl%=41 OR scan%=60 ! F2 SPUT bild$ @ellipse ENDIF IF auswahl%=42 OR scan%=61 ! F3 SPUT bild$ @n_ecken ENDIF IF auswahl%=43 OR scan%=62 ! F4 SPUT bild$ @kasten ENDIF IF auswahl%=44 OR scan%=63 ! F5 SPUT bild$ @rundkasten ENDIF IF auswahl%=45 OR scan%=64 ! F6 SPUT bild$ @vieleck ENDIF IF auswahl%=46 OR scan%=65 ! F7 SPUT bild$ @torte SPUT bild$ @bild_kurz_zeigen(100) ENDIF IF auswahl%=47 OR scan%=66 ! F8 SPUT bild$ @koerper ENDIF IF auswahl%=50 OR scan%=20 !"T" SPUT bild$ @schreiben ENDIF IF auswahl%=51 OR scan%=17 !"W" @schriftwahl ENDIF IF auswahl%=52 OR scan%=220 !"Shift T" SPUT bild$ @signum_schreiben ENDIF IF auswahl%=53 OR scan%=217 !"Shift W" SPUT bild$ @signum_einladen ENDIF IF auswahl%=54 OR scan%=234 !"Shift G" SPUT bild$ @geodreieck ENDIF IF auswahl%=55 OR scan%=46 !"C" SPUT bild$ @kurve ENDIF IF auswahl%=56 ' Diese Auswahl ist noch belegbar ENDIF IF auswahl%=57 ' Diese Auswahl ist noch belegbar ENDIF IF auswahl%=60 OR scan%=630 OR scan%=230 ! Block A oder Shift A SPUT bild$ @ausschneiden IF (BIOS(11,-1) AND 2)=2 ! linke Shift-Taste gehalten SETMOUSE x%,y% @einsetzen ENDIF ENDIF IF auswahl%=61 OR scan%=618 OR scan%=218 ! Block E oder Shift E SPUT bild$ @einsetzen ENDIF IF auswahl%=62 OR scan%=650 !"Block M" SPUT bild$ @spiegeln ENDIF IF auswahl%=63 OR scan%=623 !"Block I" SPUT bild$ @block_invert ENDIF IF auswahl%=64 OR scan%=634 !"Block G" SPUT bild$ @stauchung ENDIF IF auswahl%=65 OR scan%=632 !"Block D" @drehen ENDIF IF auswahl%=66 OR scan%=638 !"Block L" SPUT bild$ @block_laden ENDIF IF auswahl%=67 OR scan%=631 !"Block S" SPUT bild$ @block_speichern ENDIF IF auswahl%=70 OR scan%=98 OR scan%=78 OR scan%=27 ! Help oder + @hilfe ENDIF IF scan%=298 ! Shift + Help hilfe!=NOT hilfe! IF hilfe! RESTORE hilfe_ein ELSE RESTORE hilfe_aus ENDIF @hilfstext ' hilfe_ein: DATA Die Hilfsbemerkungen sind jetzt DATA eingeschaltet. DATA DATA Ausschalten mit [Shift] + [Help] DATA * hilfe_aus: DATA Die Hilfsbemerkungen sind jetzt DATA ausgeschaltet. DATA DATA Einschalten mit [Shift] + [Help] DATA * ENDIF IF auswahl%=71 OR scan%=74 OR scan%=53 !"-" @linienwahl ENDIF IF auswahl%=72 OR scan%=21 !"Z" @farbwahl ENDIF IF auswahl%=73 OR scan%=44 !"Y" @musterwahl ENDIF IF auswahl%=74 OR scan%=68 ! F10 @figur_fuellen ENDIF IF auswahl%=75 OR scan%=250 !"Shift M" @moduswahl ENDIF IF auswahl%=76 OR scan%=41 !"#" @gitter ENDIF IF auswahl%=77 OR scan%=18 !"E" @spruehdose_einstellen ENDIF IF scan%=235 !"SH" @aufhellen ENDIF IF scan%=248 !"Shift B" SPUT bild$ @testbild SPUT bild$ @bild_kurz_zeigen(100) ENDIF ' ' ****************************************************************** ' ' hier ist die Menabfrage zu Ende - nun werden die Einstellungen repariert: ' CLOSE @wahleinstellung SPOKE &H484,PEEK(&H484) AND NOT 2 ! Tastaturklickwiederholung aus anzeige!=FALSE @mauswarte ' RETURN PROCEDURE wahleinstellung GRAPHMODE mode% DEFFILL 1,muster1%,muster2% IF stil%<7 DEFLINE stil%,breite%,anfang%,ende% ELSE DEFLINE 1+NOT (&X1010101010101010),breite%,anfang%,ende% ENDIF DEFTEXT 1,schriftart%,wink%,hoehe%(ho%) COLOR farbe% BOUNDARY bound% RETURN PROCEDURE normaleinstellung GRAPHMODE 1 DEFFILL 0,2,8 DEFLINE 1,1,0,0 DEFTEXT 1,0,0,13 COLOR 1 RETURN PROCEDURE accessory abbruch!=FALSE i$="" MENU menue$() ON MENU GOSUB pulldownmenue DO ON MENU EXIT IF abbruch! LOOP MENU KILL RETURN PROCEDURE block_speichern IF hilfe! RESTORE help_blockrahmen @hilfstext ENDIF help_blockrahmen: DATA "Block mit [LMT] durch zwei" DATA "diagonal gesetzte Ecken" DATA "ausschneiden" DATA DATA "Vorschlag:" DATA "von rechts unten" DATA "nach links oben" DATA * ' DEFLINE 1,1,0,0 HIDEM GRAPHMODE 3 REPEAT SPUT bild$ ' MOUSE x%,y%,k% ! grožes Kreuz als Mauszeiger IF gitter! x%=INT((x%+x_weite%/2)/x_weite%)*x_weite% y%=INT((y%+y_weite%/2)/y_weite%)*y_weite% ENDIF LINE 0,y%,639,y% LINE x%,0,x%,399 PAUSE 2 LINE 0,y%,639,y% LINE x%,0,x%,399 UNTIL k% PAUSE 10 SPUT bild$ IF k%=1 @gummikasten GRAPHMODE 3 DEFFILL 1,2,8 ! schwarze Fllung PBOX x%,y%,x1%,y1% ! Block kurz invertieren PAUSE 40 PBOX x%,y%,x1%,y1% GET x%,y%,x1%,y1%,block$ GRAPHMODE 1 ' $I+ ! Interrupt-Routinen ein (sonst bei "Diskette voll" Fehler) dummy%=5*9 ! code-erzeugende Anweisung (siehe Compiler-Buch Kap. 2.3.8) ' IF hilfe! RESTORE help_blockspeichern @hilfstext ENDIF help_blockspeichern: DATA Die Endung ".IMG" wird vom Programm DATA "automatisch an den Namen angeh„ngt," DATA wenn man keine Endung anh„ngt. DATA DATA IMG-Dateien werden vor dem Speichern DATA komprimiert. DATA DATA Solche Bl”cke lassen sich auch mit DATA "1ST WORDPLUS" einladen. DATA DATA Bl”cke mit anderen Endungen DATA (z.B. ".BLK") werden nicht komprimiert. DATA Man braucht sie z.B. zur Weiterver- DATA arbeitung mit BASIC. DATA * ' @fileselect_titel("Block auf der Diskette speichern") ' blocksuchpfad$=blockpfad$+blockextension$ FILESELECT blocksuchpfad$,blockname$,auswahl$ blockname$="" IF EXIST(auswahl$) OUT 2,7 ' al$="Eine Datei unter diesem Namen|ist schon vorhanden!| |šberschreiben?" ALERT 2,al$,1,"ja|nein",antw% IF antw%=2 auswahl$="" ENDIF ' ENDIF IF LEN(auswahl$)>3 AND RIGHT$(auswahl$,1)<>"\" ! ausgenommen ist z.B. A:\ laufwerk%=ASC(auswahl$)-64 ' i%=RINSTR(auswahl$,".") IF i%0 ! Breite muž durch 16 teilbar sein fr Masch-progr. INC w% WEND GET 0,0,w%-1,h%,block$ IF h%<640 INC h% ! sonst geht manchmal der untere Rand verloren ENDIF @schirm1 ' BMOVE VARPTR(block$)+6,b1_adr%,LEN(block$)-6 ! Block etwas verschieben ' (SGET-Bl”cke haben 6 Byte Header) ' b1_adr%=b1_adr%+6 ! ?????? wieso geht das nicht stattdessen??? OPEN "O",#1,auswahl$ @img_einpacken(w%,h%) CLOSE #1 ELSE BSAVE auswahl$,VARPTR(block$),LEN(block$) ! Abspeichern ENDIF ENDIF ENDIF SPUT bild$ RETURN PROCEDURE aufhellen ! Aufhellen eines Bildes durch weiže Streifen SGET undo$ SPUT bild$ COLOR 0 DEFLINE 1,1,2,2 FOR i%=1 TO 640 STEP 2 LINE i%,0,i%,399 NEXT i% FOR i%=1 TO 400 STEP 2 LINE 0,i%,639,i% NEXT i% SGET bild$ @bild_kurz_zeigen(100) RETURN PROCEDURE ausdruck ausdruck%=0 ' ALERT 2,"Bild wirklich ausdrucken?",1,"ja|nein",antw% ' IF antw%=1 ' IF drucker%=0 @druck_einstell ENDIF ' abbruch%=0 DO EXIT IF OUT?(0) ' ALERT 2,"Drucker einschalten !",2,"Abbruch|OK",abbruch% EXIT IF abbruch%=1 LOOP ' IF abbruch%<>1 ' al$="Wie soll der Ausdruck|erfolgen?" SELECT drucker% CASE 1 ! 24-Nadler IF nec_emu! ALERT 2,al$,1,"l„ngs|quer",bildgroesse% ELSE ALERT 2,al$,1,"l„ngs|klein",bildgroesse% IF bildgroesse%=2 bildgroesse%=3 ENDIF ENDIF ' CASE 2 ! 9-Nadler ALERT 2,al$,1,"l„ngs|quer|klein",bildgroesse% ENDSELECT ' abbruch%=0 IF bildgroesse%=3 @schreibkasten(80,305) PRINT AT(22,10);"Wie breit soll der linke Rand sein?" PRINT AT(22,12);"(maximal 50)" PRINT AT(22,14);"Zahl eingeben, dann [Enter]-Taste" REPEAT PRINT AT(22,16);"? "; FORM INPUT 2 AS rand$ rand%=VAL(rand$) UNTIL rand%>=0 AND rand%<=50 ENDIF ' OUT 4,18 ! Maus ausschalten HIDEM ' SPUT bild$ IF drucker%=1 ! 24-Nadler ON bildgroesse% GOSUB hcopy_laengs_24,hcopy_quer_9,hcopy_klein_24 ELSE ON bildgroesse% GOSUB hcopy_laengs_9,hcopy_quer_9,hcopy_klein_9 ENDIF ENDIF ENDIF OUT 4,8 RETURN PROCEDURE druck_einstell ' ALERT 2,"Was fr ein Drucker|ist angeschlossen?",1,"24-Nadel|9-Nadel",drucker% ' @zweitschirm @schirm2 SPUT menue$ DEFTEXT 1,0,0,6 TEXT 500,25,"Druckeranpassung " IF drucker%=1 TEXT 500,35,"fr 24-Nadler" ! z.B. NEC P2200, Panasonic KX-P1124, NEC P20 ELSE TEXT 500,35,"fr 9-Nadler " ! z.B. Panasonic KX-P1092, STAR LC 10 ENDIF SGET menue$ @schirm1 ' IF drucker%=1 ! 24-Nadler @schreibkasten(20,270) PRINT AT(20,3);"Achtung! Wenn vor dem Start von KRITZEL" PRINT AT(20,4);"das Programm NEC_EMU.PRG gestartet wurde," PRINT AT(20,5);"funktionert der Ausdruck im Querformat," PRINT AT(20,6);"aber nicht der Ausdruck in klein." PRINT AT(20,8);"Wenn NEC_EMU.PRG nicht gestartet wurde," PRINT AT(20,9);"ist es genau umgekehrt..." ALERT 0,"Wurde NEC_EMU.PRG gestartet?",1,"ja|nein",antw% ' IF antw%=2 nec_emu!=FALSE ELSE nec_emu!=TRUE ENDIF ' SPUT merk$ ENDIF ' RETURN PROCEDURE ausschneiden IF hilfe! RESTORE help_blockausschneiden @hilfstext ENDIF help_blockausschneiden: DATA "Block mit zwei Mausklicks [LMT]" DATA "ausschneiden" DATA DATA "Vorschlag: von rechts unten" DATA " nach links oben" DATA DATA Wenn nur ausgeschnitten wird (nicht DATA "gedreht, gespiegelt oder gespeichert):" DATA DATA Bei gehaltener linker Shift-Taste DATA kann man den ausgeschnittenen Block DATA sofort einsetzen. DATA * ' REPEAT SPUT bild$ GRAPHMODE 3 HIDEM DEFLINE 1,1,0,0 REPEAT MOUSE x%,y%,k% ! grožes Kreuz als Mauszeiger IF gitter! x%=INT((x%+x_weite%/2)/x_weite%)*x_weite% y%=INT((y%+y_weite%/2)/y_weite%)*y_weite% ENDIF LINE 0,y%,639,y% LINE x%,0,x%,399 PAUSE 2 LINE 0,y%,639,y% LINE x%,0,x%,399 UNTIL k% PAUSE 10 SPUT bild$ IF k%=1 @gummikasten GRAPHMODE 3 DEFFILL 1,2,8 ! schwarze Fllung PBOX x%,y%,x1%,y1% ! markierten Block kurz invertieren PAUSE 20 PBOX x%,y%,x1%,y1% GET x%,y%,x1%,y1%,block$ b_breite%=x1%-x% b_hoehe%=y1%-y% GRAPHMODE 1 ELSE abbruch!=TRUE ENDIF EXIT IF abbruch! IF LEN(block$)<16 ! ganz kleine Blocks sind vermutlich ein Irrtum ' al$="Dein ausgeschnittener Block|ist aber sehr klein! Ist das" al$=al$+"|so richtig, oder willst Du|noch einmal ausschneiden?" ALERT 1,al$,1,"nochmal|richtig|Abbruch",antw% IF antw%=3 abbruch!=TRUE ENDIF ENDIF EXIT IF abbruch! UNTIL antw%=2 OR LEN(block$)>15 RETURN PROCEDURE bild_kurz_zeigen(t%) ti%=TIMER DO MOUSE x%,y%,k% PAUSE 2 EXIT IF TIMER-ti%>t% @get.tom EXIT IF MOUSEX<>x% OR MOUSEY<>y% OR scan% LOOP SPUT bild$ IF scan% @abfrage ENDIF scan%=0 RETURN PROCEDURE bildwechsel(i%) ' HIDEM bild$(bild%)=bild$ SELECT i% CASE 77 INC bild% IF bild%=6 bild%=1 ENDIF CASE 75 DEC bild% IF bild%=0 bild%=5 ENDIF ENDSELECT ' bild$=bild$(bild%) SPUT bild$ DEFTEXT 1,0,0,32 TEXT 100,100,"Bild "+STR$(bild%) @bild_kurz_zeigen(50) SPUT bild$ SGET undo$ SHOWM RETURN PROCEDURE menu_aendern @zweitschirm @schirm2 SPUT menue$ GRAPHMODE 1 DEFTEXT 1,0,0,6 TEXT 35,125,STR$(bild%) SGET menue$ @schirm1 RETURN PROCEDURE block_invert IF hilfe! RESTORE help_blockrahmen @hilfstext ENDIF DEFLINE 1,1,0,0 HIDEM GRAPHMODE 3 SGET undo$ REPEAT MOUSE x%,y%,k% ! grožes Kreuz als Mauszeiger IF gitter! x%=INT((x%+x_weite%/2)/x_weite%)*x_weite% y%=INT((y%+y_weite%/2)/y_weite%)*y_weite% ENDIF LINE 0,y%,639,y% LINE x%,0,x%,399 PAUSE 2 LINE 0,y%,639,y% LINE x%,0,x%,399 UNTIL k% PAUSE 10 SPUT bild$ IF k%=1 @gummikasten GRAPHMODE 3 DEFFILL 1,2,8 PBOX x%-1,y%-1,x1%+1,y1%+1 GET x%,y%,x1%,y1%,block$ GRAPHMODE mode% DEFFILL 1,muster1%,muster2% ENDIF SPUT bild$ @einsetzen RETURN PROCEDURE blockabfrage @schreibkasten(60,305) PRINT AT(24,6);"Blockoperationen" PRINT AT(24,8);"A = ausschneiden" PRINT AT(24,9);"E = einsetzen" PRINT AT(24,10);"M = spiegeln (""mirror"")" PRINT AT(24,11);"I = invertieren" PRINT AT(24,12);"G = Gr”že „ndern" PRINT AT(24,13);"D = drehen" PRINT AT(24,14);"S = auf Diskette speichern" PRINT AT(24,15);"L = von Diskette laden" PRINT AT(24,16);" (mit Shift gr”žere Auswahl)" PRINT AT(24,18);"andere Taste = Abbruch" REPEAT get.tom UNTIL scan% ADD scan%,600 SPUT bild$ RETURN PROCEDURE block_laden SGET undo$ ' @fileselect_titel("Block von der Diskette laden") ' IF BIOS(11,-1)=1 OR BIOS(11,-1)=2 ! Shift-Taste halten --> Auswahl m”glich IF hilfe! CLS PRINT AT(2,1);"Normal ist die Extension "".IMG"" (gepackte Bl”cke). Dateien mit der" PRINT " Extension "".BLK"" oder anderen Extensionen sind unkomprimiert" ENDIF ' al$="Welche Dateien von der|Diskette sollen zur Auswahl|angezeigt werden?" ALERT 2,al$,1,"*.IMG|*.BLK|alle",antw% SELECT antw% CASE 1 blockextension$="IMG" CASE 2 blockextension$="BLK" CASE 3 blockextension$="*" ENDSELECT ELSE blockextension$="IMG" IF hilfe! PRINT AT(2,24);"Wenn beim Aufruf ""Datei laden"" die Shift-Taste gehalten wird, hat man beim" PRINT AT(2,25);"Laden eine gr”žere Auswahl."; ENDIF ENDIF ' blocksuchpfad$=blockpfad$+blockextension$ FILESELECT blocksuchpfad$,"",auswahl$ blockname$="" SPUT bild$ IF auswahl$>"" ' i%=RINSTR(auswahl$,".") IF i%<>0 ! Falls der Dateiname eine Extension hat blockextension$=MID$(auswahl$,i%+1) ! wird die Extension herausgelesen ENDIF ' i%=RINSTR(auswahl$,"\") blockpfad$=LEFT$(auswahl$,i%)+"*." ! neuer Pfadname wird gebaut blockname$=MID$(auswahl$,i%+1) ' IF EXIST(auswahl$) ! Datei existiert? block$="" OPEN "I",#1,auswahl$ ! dann ”ffnen IF blockextension$="IMG" @img_laden IF w%=640 AND h%=400 ' al$="Das ist kein Block,|sondern ein ganzes Bild.|Soll es eingesetzt werden?" ALERT 2,al$,1,"ja|nein",antw% IF antw%=1 SPUT bild$ @bild_kurz_zeigen(100) ENDIF ELSE @einsetzen ENDIF ELSE IF LOF(#1)>32000 ' al$="Die Datei ist zu grož!|Das kann kein Block sein." ALERT 3,al$,1,"ach so",dummy% ELSE block$=SPACE$(LOF(#1)) ! Dateigr”že ermitteln BLOAD auswahl$,VARPTR(block$) ! Datei laden @einsetzen ENDIF ENDIF CLOSE #1 ! Datei schliežen ENDIF ENDIF SGET bild$ RETURN PROCEDURE dateiabfrage @schreibkasten(60,305) PRINT AT(22,7);"Diskettenoperationen" PRINT AT(22,9);"P = Speicherplatz auf der Diskette" PRINT AT(22,10);"U = Datum und Uhrzeit einstellen" PRINT AT(22,11);"L = Bild von Diskette laden" PRINT AT(22,12);" (mit Shift: gr”žere Auswahl m”glich)" PRINT AT(22,13);"S = Bild auf Diskette speichern" PRINT AT(22,14);"Delete = Datei von der Diskette l”schen" PRINT AT(22,15);"O = Ordner auf der Diskette anlegen" PRINT AT(22,17);"andere Taste = Abbruch" REPEAT @get.tom UNTIL scan% ADD scan%,400 SPUT bild$ RETURN PROCEDURE datei_einstellen IF BIOS(11,-1)=1 OR BIOS(11,-1)=2 ! Shift-Taste halten --> Auswahl m”glich IF hilfe! CLS PRINT AT(2,1);"Normal ist die Extension "".PAC"" (gepackte Bilder). Bild-Dateien mit der" PRINT " Extension "".IMG"" (weniger gut gepackt) sind evtl. auch nur Ausschnitte!" PRINT " Bild-Dateien mit der Extension "".PIC"" sind unkomprimiert (32000 K pro Bild)" ENDIF @schreibkasten(60,305) i$="" PRINT AT(20,6);"Welche Dateien von der Diskette sollen" PRINT AT(20,7);"zur Auswahl angezeigt werden?" antw%=1 DO BOUNDARY 1 GRAPHMODE 1 DEFFILL 0,2,8 FOR i%=1 TO 4 PBOX 180,132+i%*32,460,164+i%*32 BOX 180,132+i%*32,460,164+i%*32 NEXT i% PRINT AT(25,12);"Dateien mit der Endung .PAC (1)" PRINT AT(25,14);"Dateien mit der Endung .IMG (2)" PRINT AT(25,16);"Dateien mit der Endung .PIC (3)" PRINT AT(25,18);"alle Dateien (4)" DEFFILL 1,1,1 GRAPHMODE 3 PBOX 180,132+antw%*32,460,164+antw%*32 @mauswarte EXIT IF i$<>"" EXIT IF ASC(i$)=13 OR i$<>"" DO MOUSE x%,y%,k% i$=INKEY$ EXIT IF (k%=1 AND x%>180 AND x%<460 AND y%>164 AND y%<292) OR ASC(i$)=13 EXIT IF VAL(i$)>0 AND VAL(i$)<5 LOOP IF k%=1 AND x%>180 AND x%<460 AND y%>164 AND y%<292 antw%=INT((y%-132)/32) i$=" "+STR$(antw%) ENDIF IF VAL(i$)>0 antw%=VAL(i$) i$=" "+STR$(antw%) ENDIF LOOP ' SELECT antw% CASE 1 extension$="PAC" IF RIGHT$(dateiname$(bild%),3)<>"PAC" dateiname$(bild%)="" ENDIF CASE 2 extension$="IMG" IF RIGHT$(dateiname$(bild%),3)<>"IMG" dateiname$(bild%)="" ENDIF CASE 3 extension$="PIC" IF RIGHT$(dateiname$(bild%),3)<>"PIC" dateiname$(bild%)="" ENDIF CASE 4 extension$="*" dateiname$(bild%)="" ENDSELECT ELSE extension$="PAC" IF RIGHT$(dateiname$(bild%),3)<>"PAC" dateiname$(bild%)="" ENDIF ENDIF DEFTEXT 1,0,0,6 RETURN PROCEDURE datei_loeschen ' pfad$=laufwerk$+"*." geloescht!=FALSE REPEAT suchpfad$=pfad$+"*" @fileselect_titel("Datei von der Diskette l”schen") FILESELECT suchpfad$,"",auswahl$ EXIT IF NOT EXIST(auswahl$) ' al$="Die Datei|"+auswahl$+"|von der Diskette l”schen ?" ALERT 3,al$,2,"ja|nein",antw% IF antw%=1 KILL auswahl$ laufwerk%=ASC(auswahl$)-64 geloescht!=TRUE ENDIF ' i%=RINSTR(auswahl$,"\") pfad$=LEFT$(auswahl$,i%)+"*." ! neuer Pfadname wird gebaut dateiname$(bild%)=MID$(auswahl$,i%+1) ' UNTIL antw%=2 OR auswahl$="" OR RIGHT$(auswahl$)="\" IF geloescht! @speicherplatz ENDIF pfad$=laufwerk$+"*." RETURN PROCEDURE datum_und_uhr HIDEM SGET merk$ CLS PRINT PRINT " eingestelltes Datum: ";DATE$ PRINT PRINT " eingestellte Zeit: ";TIME$;" Uhr" PRINT PRINT " alles richtig? (J/N)" DO PRINT AT(23,4);TIME$; i$=UPPER$(INKEY$) EXIT IF i$="N" OR i$="J" EXIT IF i$=CHR$(13) OR MOUSEK>1 LOOP IF i$="N" REPEAT CLS da$="" PRINT AT(2,5);"Bitte das Datum eingeben:" REPEAT PRINT AT(2,7);"Tag : "; FORM INPUT 2,i$ UNTIL VAL(i$)>0 AND VAL(i$)<32 IF ASC(RIGHT$(i$,1))<48 OR ASC(RIGHT$(i$,1))>57 i$=LEFT$(i$,1) ENDIF IF LEN(i$)=1 i$="0"+i$ ENDIF PRINT AT(2,7);"Tag : ";i$ da$=i$ REPEAT PRINT AT(2,8);"Monat: "; FORM INPUT 2,i$ UNTIL VAL(i$)>0 AND VAL(i$)<13 IF ASC(RIGHT$(i$,1))<48 OR ASC(RIGHT$(i$,1))>57 i$=LEFT$(i$,1) ENDIF IF LEN(i$)=1 i$="0"+i$ ENDIF PRINT AT(2,8);"Monat: ";i$ da$=da$+"."+i$ REPEAT PRINT AT(2,9);"Jahr : 19"; FORM INPUT 2,i$ IF VAL(i$)<1 i$="91" ! diese Zeile gilt fr 1991 ENDIF UNTIL VAL(i$)>88 AND VAL(i$)<100 ! nach 1999 „ndern .... (???) i$="19"+i$ PRINT AT(2,9);"Jahr : "+i$ da$=da$+"."+i$ ' uhrzeit$="" PRINT AT(2,12);"Bitte die Uhrzeit eingeben:" REPEAT PRINT AT(2,14);"Stunde : "; FORM INPUT 2,i$ UNTIL VAL(i$)>-1 AND VAL(i$)<24 IF VAL(i$)=0 i$="15" ENDIF WHILE LEN(i$)<2 i$="0"+i$ WEND PRINT AT(2,14);"Stunde : ";i$ uhrzeit$=i$ REPEAT PRINT AT(2,15);"Minute : "; FORM INPUT 2,i$ UNTIL VAL(i$)>-1 AND VAL(i$)<61 WHILE LEN(i$)<2 i$="0"+i$ WEND uhrzeit$=uhrzeit$+":"+i$+":"+"00" ' SETTIME uhrzeit$,da$ CLS PRINT PRINT " eingestelltes Datum: ";DATE$ PRINT PRINT " eingestellte Zeit: ";TIME$;" Uhr" PRINT PRINT " alles richtig? (J/N)" DO PRINT AT(23,4);TIME$; i$=UPPER$(INKEY$) EXIT IF i$="N" OR i$="J" EXIT IF i$=CHR$(13) OR MOUSEK>1 LOOP UNTIL i$="J" OR i$=CHR$(13) ENDIF PRINT AT(29,6);"JA" PAUSE 30 SPUT merk$ SHOWM RETURN PROCEDURE drehen SPUT bild$ SGET undo$ @ausschneiden IF NOT abbruch! REPEAT @schreibkasten(60,305) DEFLINE 1,1,0,1 CIRCLE 300,200,50,0,2700 PRINT AT(24,8); INPUT "Drehwinkel (maximal 359ø): ",i$ winkel#=VAL(i$) UNTIL winkel#>=0 AND winkel#<360 ' SPUT bild$ abbruch!=FALSE IF winkel#>0 IF winkel#>=180 winkel#=winkel#-180 @mirrorput(x%,y%,1,*block$) GET x%,y%,x1%,y1%,block$ @mirrorput(x%,y%,2,*block$) GET x%,y%,x1%,y1%,block$ ENDIF ' ' Diese Procedure entwickelte Thilo Jantz, Portsloge: ' IF winkel#>0 @block_drehen(winkel#) ENDIF SPUT bild$ IF NOT abbruch! @einsetzen ENDIF a%=MAX(a%,b1_adr%) VOID XBIOS(5,L:a%,L:a%,-1) ENDIF ENDIF RETURN PROCEDURE block_drehen(winkel#) LOCAL x1#,y1#,cos#,sin#,bx0#,by0#,bx1#,by1#,a#,x#,y#,sicher$ ' ' Maže des Quellblockes ermitteln ' a#=VARPTR(block$) x1#=256*PEEK(a#+0)+PEEK(a#+1) !Breite des Quellblocks y1#=256*PEEK(a#+2)+PEEK(a#+3) !H”he des Quellblocks ' ' (gedrehte) Blockmaske (Polygon) berechnen ' cos#=COSQ(winkel#) sin#=SINQ(winkel#) ' ERASE x#(),y#() DIM x#(4),y#(4) x#(0)=0 y#(0)=0 x#(1)=cos#*x1# y#(1)=sin#*x1# x#(2)=cos#*x1#-sin#*y1# y#(2)=sin#*x1#+cos#*y1# x#(3)=-sin#*y1# y#(3)=cos#*y1# ' ' Ausgabeposition auf dem Bildschirm berechnen ' = Rausdrehen aus dem Bildbereich vermeiden ' bx0#=0 by0#=0 bx1#=0 by1#=0 ' FOR a#=0 TO 3 x#(a#)=ROUND(x#(a#)) y#(a#)=ROUND(y#(a#)) IF x#(a#)bx1# bx1#=x#(a#) ENDIF IF y#(a#)>by1# by1#=y#(a#) ENDIF NEXT a# ' FOR a#=0 TO 3 ADD x#(a#),-bx0# ADD y#(a#),-by0# NEXT a# x#(4)=x#(0) y#(4)=y#(0) ' ADD bx1#,-bx0# ADD by1#,-by0# ' HIDEM @zweitschirm @schirm2 ' CLS PUT 0,0,block$ ! Original auf Schirm2 ausgeben @schirm1 ' ' Auf Schirm1 den Zielbereich freimachen ' GET 0,0,bx1#+1,by1#+1,sicher$ DEFFILL 1,0,0 PBOX -1,-1,bx1#+1,by1#+1 ' ' Das Drehen ' GRAPHMODE 2 FOR x#=0 TO x1# FOR y#=0 TO y1# @schirm2 COLOR POINT(x#,y#) @schirm1 PLOT -bx0#+(cos#*x#-sin#*y#),-by0#+(sin#*x#+cos#*y#) NEXT y# IF INKEY$>"" OR MOUSEK=2 ALERT 2,"Drehung abbrechen?",2,"ja|nein",antw% IF antw%=1 abbruch!=TRUE ENDIF ENDIF EXIT IF abbruch! NEXT x# GRAPHMODE 1 ' ' Block nehmen und Untergrund wiederherstellen ' GET 0,0,bx1#,by1#,block$ PUT 0,0,sicher$ ' SHOWM RETURN PROCEDURE einsetzen ON BREAK CONT ! sonst erwischt man evtl. genau den Zweitschirm SGET undo$ SPUT bild$ @zweitschirm IF hilfe! RESTORE help_einsetzen @hilfstext ENDIF help_einsetzen: DATA Ausschnitt mit Mausklick [LMT] an DATA den gewnschten Stellen einsetzen. DATA DATA Ende mit [RMT] DATA DATA Bei gehaltener Shift-Taste kann man DATA in die benachbarten Bilder verschieben. DATA DATA Auch mit den Pfeiltasten kann man in DATA das benachbarte Bild wechseln. DATA DATA Mit den Zifferntasten 1 bis 4 l„žt sich DATA der Graphikmodus ver„ndern. DATA * ' DEFLINE 1,1,0,0 COLOR 1 REPEAT SWAP a%,b1_adr% VOID XBIOS(5,L:a%,L:b1_adr%,-1) ' SPUT bild$ @get.tom ' IF scan%>0 SELECT scan% CASE 2,109 mode%=1 p_mode%=3 CASE 3,110 mode%=2 p_mode%=7 CASE 4,111 mode%=3 p_mode%=6 CASE 5,106 mode%=4 p_mode%=13 CASE 75 @bildwechsel(75) CASE 77 @bildwechsel(77) ENDSELECT ENDIF ' IF (taste% AND 2)=2 ! bei gehaltener linker Shift-Taste kann ins n„chste IF x%=0 ! Bild geschoben werden SETMOUSE 630,y% @bildwechsel(75) ENDIF IF x%=639 SETMOUSE 10,y% @bildwechsel(77) ENDIF ENDIF ' IF gitter! x%=INT((x%+x_weite%/2)/x_weite%)*x_weite% y%=INT((y%+y_weite%/2)/y_weite%)*y_weite% ENDIF PUT x%,y%,block$,p_mode% IF k%=1 SGET bild$ ! Bild mit Block einfangen MOUSE x%,y%,k% WHILE MOUSEK ! warten, bis Maustaste losgelassen EXIT IF MOUSEX<>x% OR MOUSEY<>y% ! oder Maus bewegt wird MOUSE x%,y%,k% WEND ENDIF ' LINE x%,0,x%,399 ! grožes Kreuz als Mauszeiger LINE 0,y%,639,y% UNTIL k%=2 a%=MAX(a%,b1_adr%) VOID XBIOS(5,L:a%,L:a%,-1) ' @menu_aendern ! ge„nderte Einstellungen eintragen @modus_eintragen SPUT bild$ ON BREAK GOSUB schluss RETURN PROCEDURE ellipse SGET undo$ DEFMOUSE 7 ' IF hilfe! RESTORE help_elli @hilfstext ENDIF help_elli: DATA Zuerst Mittelpunkt anklicken, DATA dann L„nge und Breite DATA der Ellipsen mit Maus bestimmen. DATA DATA Ellipsen bernehmen mit [LMT] DATA DATA Aufh”ren mit [RMT] DATA * ' DO COLOR 1 DEFLINE 1,1,0,0 REPEAT MOUSE x%,y%,k% UNTIL k% EXIT IF k%>1 OR INKEY$=CHR$(27) @mauswarte IF gitter! x%=INT((x%+x_weite%/2)/x_weite%)*x_weite% y%=INT((y%+y_weite%/2)/y_weite%)*y_weite% ENDIF GRAPHMODE 3 PAUSE 10 REPEAT MOUSE x1%,y1%,k% IF gitter! x1%=INT((x1%+x_weite%/2)/x_weite%)*x_weite% y1%=INT((y1%+y_weite%/2)/y_weite%)*y_weite% ENDIF ELLIPSE x%,y%,ABS(x1%-x%),ABS(y1%-y%) PAUSE 2 ELLIPSE x%,y%,ABS(x1%-x%),ABS(y1%-y%) UNTIL k% EXIT IF k%>1 OR INKEY$=CHR$(27) GRAPHMODE mode% IF stil%<7 DEFLINE stil%,breite%,2,2 ELSE DEFLINE 1+NOT (&X1010101010101010),breite%,2,2 ENDIF DEFFILL 1,muster1%,muster2% COLOR farbe% IF figurfuellen! PELLIPSE x%,y%,ABS(x1%-x%),ABS(y1%-y%) ELSE ELLIPSE x%,y%,ABS(x1%-x%),ABS(y1%-y%) ENDIF PAUSE 5 @mauswarte LOOP SGET bild$ RETURN PROCEDURE farbwahl GRAPHMODE 1 f$=" weiž " IF farbe%=1 farbe%=0 ELSE farbe%=1 f$="schwarz" ENDIF @zweitschirm @schirm2 SPUT menue$ DEFTEXT 1,0,0,6 TEXT 162,390," "+f$ SGET menue$ @schirm1 RETURN PROCEDURE fehler IF ERR=8 ' al$="Der Speicherplatz reicht nicht|aus fr dieses Programm!" al$=al$+"|Evtl. Accessories weglassen|oder Ramdisk verkleinern..." ALERT 1,al$,1,"Abbruch",dummy% EDIT ELSE IF ERR=-34 ' al$="Der gew„hlte Ordner war|auf dieser Diskette|nicht vorhanden!|Bitte noch einmal versuchen!" ALERT 1,al$,1,"ach so",dummy% laufwerk%=GEMDOS(25)+1 laufwerk$=CHR$(GEMDOS(25)+65)+":"+"\" pfad$(bild%)=laufwerk$+"*." pfad$=laufwerk$+"*." dateiname$(bild%)="" blockextension$="IMG" blockpfad$=laufwerk$+"*." blockname$="" ELSE IF ERR=37 ' al$="Die Diskette ist voll!| |Dein Bild ist wahrscheinlich|fehlerhaft gespeichert worden!" ALERT 1,al$,1,"Mist",dummy% ELSE ~FORM_ALERT(1,ERR$(ERR)) ENDIF ON BREAK GOSUB schluss ON ERROR GOSUB fehler RESUME neustart RETURN PROCEDURE figur_fuellen SPUT menue$ GRAPHMODE 1 DEFTEXT 1,0,0,6 IF figurfuellen! figurfuellen!=FALSE TEXT 322,390," nein" bound%=1 ELSE figurfuellen!=TRUE TEXT 322,390," ja " ' al$="Figuren werden jetzt gefllt|gezeichnet.|" al$=al$+"Sollen sie auch einen Rand|bekommen?" ALERT 2,al$,1,"ja|nein",antw% IF antw%=1 bound%=1 ELSE bound%=0 ENDIF ENDIF GRAPHMODE 1 SGET menue$ RETURN PROCEDURE fileselect_titel(titel$) titel$=LEFT$(titel$,36) ! Text soll max. 36 Zeichen lang sein DEFLINE 1,1,0,0 COLOR 1 dummy%=(36-LEN(titel$))/2 titel$=SPACE$(dummy%)+titel$ ! Text zentrieren GRAPHMODE 1 DEFFILL 1,2,8 PBOX 162,10,482,50 DEFFILL 0,2,8 PBOX 158,6,478,46 BOX 158,6,478,46 PRINT AT(23,2);titel$ RETURN PROCEDURE freihand SGET undo$ IF hilfe! RESTORE help_standard @hilfstext ENDIF help_standard: DATA "Die linke Maustaste =[LMT]" DATA "macht die gew„hlte Arbeit" DATA "(z.B. Zeichnen, Radieren)" DATA DATA "[Backspace] nimmt (meist)" DATA "die letzte Aktion zurck" DATA DATA "Die rechte Maustaste =[RMT]" DATA "oder [Esc] beenden die Arbeit" DATA DATA "[Undo] macht sp„ter alles" DATA "ungetan" DATA * ' IF stil%<7 DEFLINE stil%,breite%,2,2 ELSE DEFLINE 1+NOT (&X1010101010101010),breite%,2,2 ENDIF DEFMOUSE 7 DO GRAPHMODE mode% IF mode%=4 ! mit Graphikmodus 4 sieht man nichts GRAPHMODE 1 ENDIF COLOR farbe% REPEAT x$=UPPER$(INKEY$) MOUSE x%,y%,k% UNTIL k% OR x$=CHR$(8) IF x$=CHR$(8) SPUT merk$ k%=0 ENDIF EXIT IF k%>1 OR INKEY$=CHR$(27) SGET merk$ IF MOUSEK=1 PLOT MOUSEX,MOUSEY ENDIF WHILE MOUSEK=1 MOUSE x%,y%,k% DRAW TO x%,y% PAUSE 3 ! Dadurch werden die Linien gegl„ttet WEND EXIT IF k%>1 OR INKEY$=CHR$(27) LOOP SGET bild$ RETURN PROCEDURE fuellen SGET undo$ IF hilfe! RESTORE help_fuellen @hilfstext ENDIF help_fuellen: DATA Fllen: linke Maustaste [LMT] DATA DATA Aufh”ren: rechts [RMT] DATA DATA Muster wechseln: Y DATA DATA Zurcknehmen: [Backspace] DATA * ' DEFFILL 1,muster1%,muster2% DEFMOUSE 0 IF x$="Y" @musterwahl ENDIF SPUT bild$ DO REPEAT MOUSE x%,y%,k% x$=UPPER$(INKEY$) IF x$="Y" @musterwahl k%=0 ENDIF UNTIL k% OR x$=CHR$(8) EXIT IF k%>1 OR INKEY$=CHR$(27) IF x$=CHR$(8) SPUT merk$ ENDIF SGET merk$ IF k%=1 FILL x%,y% ENDIF @mauswarte LOOP SGET bild$ RETURN PROCEDURE gerade SGET undo$ IF hilfe! RESTORE help_gerade @hilfstext ENDIF help_gerade: DATA Geraden ziehen mit zwei Mausklicks DATA (linke Maustaste) DATA DATA L”schen der letzten Geraden mit DATA [Backspace] DATA DATA Beenden mit rechter Taste! DATA * ' DEFMOUSE 7 REPEAT MOUSE x%,y%,k% UNTIL k% @mauswarte DO COLOR 1 DEFLINE 1,1,0,0 WHILE k%=0 MOUSE x%,y%,k% x$=UPPER$(INKEY$) EXIT IF x$=CHR$(8) WEND @mauswarte IF x$=CHR$(8) SPUT merk$ ELSE IF gitter! x%=INT((x%+x_weite%/2)/x_weite%)*x_weite% y%=INT((y%+y_weite%/2)/y_weite%)*y_weite% ENDIF EXIT IF k%>1 OR INKEY$=CHR$(27) SGET merk$ GRAPHMODE 3 REPEAT MOUSE x1%,y1%,k% IF gitter! x1%=INT((x1%+x_weite%/2)/x_weite%)*x_weite% y1%=INT((y1%+y_weite%/2)/y_weite%)*y_weite% ENDIF LINE x%,y%,x1%,y1% PAUSE 2 LINE x%,y%,x1%,y1% UNTIL k% @mauswarte EXIT IF k%>1 OR INKEY$=CHR$(27) GRAPHMODE mode% IF stil%<7 DEFLINE stil%,breite%,anfang%,ende% ELSE DEFLINE 1+NOT (&X1010101010101010),breite%,anfang%,ende% ENDIF COLOR farbe% LINE x%,y%,x1%,y1% ENDIF k%=0 LOOP SGET bild$ RETURN PROCEDURE geodreieck PAUSE 10 ' al$="Was m”chtest Du zeichnen?" ALERT 2,al$,0,"Winkel|Parallel|Abbruch",antw% IF antw%<3 SGET undo$ SPUT bild$ IF hilfe! SELECT antw% CASE 1 RESTORE help_geo_1 CASE 2 RESTORE help_geo_2 ENDSELECT @hilfstext ENDIF help_geo_2: DATA "Parallelen zeichnen:" DATA DATA "Erst die Gerade aufnehmen" DATA "mit zweimal linker Maustaste" DATA "(wird wieder entfernt)" DATA DATA "Dann Parallelen setzen" DATA * help_geo_1: DATA "Winkel zeichnen:" DATA DATA "Ersten Schenkel zeichnen -" DATA "beim Scheitelpunkt beginnen" DATA "(wird wieder entfernt)" DATA DATA "Dann Winkel festlegen und" DATA "zweiten Schenkel zeichnen" DATA "oder nur messen und" DATA "mit [RMT] abbrechen" DATA * ' DEFMOUSE 7 GRAPHMODE 3 DEFLINE 1,1,0,0 REPEAT MOUSE x%,y%,k% UNTIL k% PAUSE 10 @mauswarte HIDEM REPEAT MOUSE x1%,y1%,k% LINE x%,y%,x1%,y1% PAUSE 2 LINE x%,y%,x1%,y1% UNTIL k% ' SELECT antw% CASE 1 ! Winkel REPEAT GRAPHMODE 1 DEFLINE 1,1,0,0 LINE x1%,y1%,x%,y% GRAPHMODE 3 a#=SQR(ABS((x%-x1%)^2+(y%-y1%)^2)) @mauswarte REPEAT MOUSE x2%,y2%,k% LINE x%,y%,x2%,y2% IF x2%<>x% OR y2%<>y% b#=SQR(ABS((x2%-x%)^2+(y2%-y%)^2)) c#=SQR(ABS((x2%-x1%)^2+(y2%-y1%)^2)) IF a#*b#>0 AND ((c#^2-a#^2-b#^2)/(-2*a#*b#))<=1 winkel#=ACOS((c#^2-a#^2-b#^2)/(-2*a#*b#)) winkel#=winkel#*180/PI PRINT AT(2,2);INT(10*winkel#+0.5)/10;CHR$(248)'' ENDIF ENDIF LINE x%,y%,x2%,y2% UNTIL k% GRAPHMODE mode% IF stil%<7 DEFLINE stil%,breite%,anfang%,ende% ELSE DEFLINE 1+NOT (&X1010101010101010),breite%,anfang%,ende% ENDIF IF k%=1 SPUT bild$ LINE x%,y%,x2%,y2% SGET bild$ ENDIF UNTIL k%=2 SPUT bild$ CASE 2 ! Parallele zeichnen x1%=x1%-x% y1%=y1%-y% REPEAT @mauswarte GRAPHMODE 3 DEFLINE 1,1,0,0 REPEAT MOUSE x%,y%,k% IF gitter! x%=INT((x%+x_weite%/2)/x_weite%)*x_weite% y%=INT((y%+y_weite%/2)/y_weite%)*y_weite% ENDIF LINE x%,y%,x%-x1%,y%-y1% PAUSE 2 LINE x%,y%,x%-x1%,y%-y1% UNTIL k% IF k%=1 GRAPHMODE mode% IF stil%<7 DEFLINE stil%,breite%,anfang%,ende% ELSE DEFLINE 1+NOT (&X1010101010101010),breite%,anfang%,ende% ENDIF LINE x%,y%,x%-x1%,y%-y1% ENDIF UNTIL k%=2 ENDSELECT SHOWM SGET bild$ ENDIF RETURN PROCEDURE gitter SGET merk$ ' @schreibkasten(60,305) PRINT AT(20,6);"Wenn das Gitter eingeschaltet ist, rasten" PRINT AT(20,7);"gerade Linien, Kreise, Ellipsen, Bl”cke..." PRINT AT(20,8);"an bestimmten Bildschirmstellen ein." ' IF gitter! i%=2 al$="Das Gitter ist eingeschaltet.| |Gitterweite: "+STR$(x_weite%)+"*"+STR$(y_weite%)+" Pixel" ELSE i%=3 al$="Das Gitter ist ausgeschaltet." ENDIF ' ALERT 1,al$,i%,"OK|aus|„ndern",antw% IF antw%=2 gitter!=FALSE ENDIF ' GRAPHMODE 1 ' IF antw%=3 gitter!=TRUE ' ALERT 2,"Neue Gitterweite:",2,"10*10|20*20|anders",antw% SELECT antw% CASE 1 x_weite%=10 y_weite%=10 CASE 2 x_weite%=20 y_weite%=20 CASE 3 @schreibkasten(60,350) DEFTEXT 1,0,0,13 PRINT AT(21,5);"Gitterweite „ndern mit Pfeiltasten" PRINT AT(21,6);"Mit [Shift] ist Žnderung um 10 m”glich." DEFFILL 0,2,8 ' FOR i%=1 TO 4 BOX 360+25*i%,180,385+25*i%,205 TEXT 370+25*i%,200,CHR$(i%) NEXT i% BOX 385,220,485,245 BOX 386,221,484,244 TEXT 425,240,"OK" ' REPEAT PBOX 160,140,360,340 ! weižer Kasten PRINT AT(49,10);STR$(x_weite%)+"*"+STR$(y_weite%);" Pixel"' FOR i%=160 TO 360 STEP x_weite% ! senkreche Linien LINE i%,140,i%,340 NEXT i% FOR i%=140 TO 340 STEP y_weite% ! waagerechte Linien LINE 160,i%,360,i% NEXT i% REPEAT @get.tom IF k% AND (x%>385 AND x%<485 AND y%>180 AND y%<245) PAUSE 3 x%=INT((x%-360)/25) IF y%>220 scan%=28 x%=0 ENDIF SELECT x% CASE 1 scan%=72 CASE 2 scan%=80 CASE 3 scan%=77 CASE 4 scan%=75 ENDSELECT ENDIF ' IF scan%>0 SELECT scan% CASE 75 ! <- IF BIOS(11,-1)=1 OR BIOS(11,-1)=2 ! Shift-Taste gehalten SUB x_weite%,10 ELSE DEC x_weite% ENDIF IF x_weite%<=1 x_weite%=2 ENDIF CASE 77 ! -> IF BIOS(11,-1)=1 OR BIOS(11,-1)=2 ADD x_weite%,10 ELSE INC x_weite% ENDIF IF x_weite%>=201 x_weite%=200 ENDIF CASE 72 ! ^ IF BIOS(11,-1)=1 OR BIOS(11,-1)=2 SUB y_weite%,10 ELSE DEC y_weite% ENDIF IF y_weite%<=1 y_weite%=2 ENDIF CASE 80 ! v IF BIOS(11,-1)=1 OR BIOS(11,-1)=2 ADD y_weite%,10 ELSE INC y_weite% ENDIF IF y_weite%>=201 y_weite%=200 ENDIF ENDSELECT ENDIF UNTIL scan%>0 UNTIL scan%=28 OR scan%=114 OR k%>1 ENDSELECT ENDIF ' @zweitschirm @schirm2 SPUT menue$ DEFTEXT 1,0,0,6 IF gitter! TEXT 482,390," " TEXT 482,390," "+STR$(x_weite%)+"*"+STR$(y_weite%) ELSE TEXT 482,390," aus " ENDIF SGET menue$ @schirm1 RETURN PROCEDURE gummikasten abbruch!=FALSE COLOR 1 DEFLINE 1,1,0,0 GRAPHMODE 3 IF gitter! x%=INT((x%+x_weite%/2)/x_weite%)*x_weite% y%=INT((y%+y_weite%/2)/y_weite%)*y_weite% ENDIF @mauswarte PAUSE 10 REPEAT MOUSE x1%,y1%,k% IF gitter! x1%=INT((x1%+x_weite%/2)/x_weite%)*x_weite% y1%=INT((y1%+y_weite%/2)/y_weite%)*y_weite% ENDIF BOX x%,y%,x1%,y1% PAUSE 2 BOX x%,y%,x1%,y1% UNTIL k% @mauswarte IF k%>1 abbruch!=TRUE ENDIF @wahleinstellung IF x1%>=640 x1%=639 ENDIF IF y1%>=400 y1%=399 ENDIF IF x1%1 abbruch!=TRUE ENDIF GRAPHMODE mode% IF stil%<7 DEFLINE stil%,breite%,anfang%,ende% ELSE DEFLINE 1+NOT (&X1010101010101010),breite%,anfang%,ende% ENDIF DEFFILL 1,muster1%,muster2% COLOR farbe% RETURN PROCEDURE hcopy_laengs_24 ! aus dem "GFA-BASIC-Buch von F. Ostrowski LPRINT CHR$(27);"@"; ! Drucker initialisieren i$=SPACE$(400) g$=" "+CHR$(27)+"*"+CHR$(0)+CHR$(400)+CHR$(400/256) !fr NEC P2200 OPEN "",#99,"LST:" FOR i%=XBIOS(3) TO i%+79 abbruch%=0 x%=VARPTR(i$) FOR j%=i%+399*80 TO i% STEP -80 POKE x%,PEEK(j%) INC x% NEXT j% FOR j%=0 TO 2 PRINT #99,g$;i$;CHR$(13);CHR$(27);"J";CHR$(1); IF INKEY$<>"" OUT 4,8 ' ALERT 2,"Ausdruck abbrechen?",1,"ja|nein",abbruch% ENDIF EXIT IF abbruch%=1 NEXT j% PRINT #99,CHR$(27);"J";CHR$(21); EXIT IF abbruch%=1 NEXT i% CLOSE #99 RETURN PROCEDURE hcopy_klein_24 ! von Konstantinos Lavassas fr TOS - Magazin abbruch!=FALSE ' adr%=XBIOS(3) drucker_init$=CHR$(27)+"l"+CHR$(rand%) ! Linker Rand oder „hnliches start$=CHR$(27)+"*"+CHR$(39)+CHR$(144)+CHR$(1) ! Druckersteuerung ' ESC * ' = 399 ! (siehe Text) ' vorschub$=CHR$(27)+"J"+CHR$(23)+CHR$(13) ! Zeilenvorschub einstellen ' OPEN "O",#99,"LST:" ! Ausgabe auf Printer PRINT #99,drucker_init$; ' PRINT #99,CHR$(13) ! Zeilenvorschub FOR i%=0 TO 78 STEP 3 ! alle Spalten durch IF INKEY$<>"" OUT 4,8 ' ALERT 2,"Ausdruck abbrechen?",1,"ja|nein",abbruch% ENDIF EXIT IF abbruch%=1 PRINT #99,start$; FOR j%=399 TO 0 STEP -1 ! alle Zeilen durch date%=adr%+(j%*80)++i% ! Daten holen PRINT #99,CHR$(PEEK(date%+0)); ! und jeweils 3 hinterein- PRINT #99,CHR$(PEEK(date%+1)); ! ander ausgeben, bei den IF i%<78 ! letzten Zeilen PRINT #99,CHR$(PEEK(date%+2)); ! nur zwei Spalten ELSE ! drucken PRINT #99,CHR$(0); ENDIF NEXT j% PRINT #99,vorschub$; ! passender Zeilenvorschub NEXT i% ' CLOSE #99 RETURN PROCEDURE hcopy_laengs_9 ! aus dem "GFA-BASIC-Buch von F. Ostrowski LPRINT CHR$(27);"@"; ! Drucker initialisieren i$=SPACE$(400) g$=" "+CHR$(27)+"*"+CHR$(5)+CHR$(400)+CHR$(400/256)!fr Panasonic KXP1092 OPEN "",#99,"LST:" FOR i%=XBIOS(3) TO i%+79 abbruch%=0 x%=VARPTR(i$) FOR j%=i%+399*80 TO i% STEP -80 POKE x%,PEEK(j%) INC x% NEXT j% FOR j%=0 TO 1 PRINT #99,g$;i$;CHR$(13);CHR$(27);"J";CHR$(1); IF INKEY$<>"" OUT 4,8 ' ALERT 2,"Ausdruck abbrechen?",1,"ja|nein",abbruch% ENDIF EXIT IF abbruch%=1 NEXT j% PRINT #99,CHR$(27);"J";CHR$(22); EXIT IF abbruch%=1 NEXT i% CLOSE #99 RETURN PROCEDURE hcopy_quer_9 LPRINT CHR$(27);"@"; ! Drucker initialisieren abbruch%=0 IF abbruch%<>2 HARDCOPY ENDIF RETURN PROCEDURE hcopy_klein_9 ! von Josef Wiggermann, S”gel LOCAL start_adr%,druckzeile$,zeile%,sp%,bit%,p%,adr%,ak_adr%,top%,fett% DIM inhalt%(7) ' rand%=ABS(rand%) ! rand% = linker Rand rand%=MIN(rand%,50) ' start_adr%=XBIOS(2) ' OPEN "",#99,"LST:" ' FOR zeile%=1 TO 50 STEP 3 FOR durchgang%=0 TO 2 druckzeile$=STRING$(640,0) sp%=VARPTR(druckzeile$) top%=sp% FOR adr%=start_adr% TO start_adr%+76 STEP 4 ak_adr%=adr%+durchgang%*80 was_da!=FALSE FOR bit%=7 DOWNTO 0 inhalt%(bit%)={ak_adr%} IF inhalt%(bit%)<>0 was_da!=TRUE ENDIF ADD ak_adr%,80*3 NEXT bit% IF was_da!=TRUE FOR p%=31 DOWNTO 0 ' FOR bit%=7 DOWNTO 0 IF BTST(inhalt%(bit%),p%) BYTE{sp%}=BSET(BYTE{sp%},bit%) ENDIF NEXT bit% ' INC sp% NEXT p% top%=sp% ' ELSE ADD sp%,32 ENDIF NEXT adr% ' top%=top%-VARPTR(druckzeile$) g$=CHR$(27)+"*"+CHR$(3)+CHR$(top%)+CHR$(top%/256) ' FOR fett%=1 TO 1 ! 1 = normal, 2 = fetter (mehr als 3 ist sinnlos) PRINT #99,SPACE$(rand%);g$;LEFT$(druckzeile$,top%);CHR$(13); NEXT fett% ' PRINT #99,CHR$(27);"J";CHR$(1); NEXT durchgang% PRINT #99,CHR$(27);"J";CHR$(21); ' ' ADD start_adr%,640*3 abbruch%=0 IF LEN(INKEY$) OR MOUSEK OUT 4,8 ' ALERT 2,"Ausdruck abbrechen?",1,"ja|nein",abbruch% ENDIF EXIT IF abbruch%<>0 NEXT zeile% ' ERASE inhalt%() CLOSE #99 ' LPRINT CHR$(12); evtl. Seitenvorschub RETURN PROCEDURE hilfe GRAPHMODE 1 CLS PRINT PRINT " K R I T Z E L - Kurzanleitung" PRINT PRINT " Mit der linken Maustaste [LMT] wird gearbeitet, mit der rechten [RMT] wird" PRINT " beendet. Die [RMT] oder die Leertaste schalten vom Men zum Bild hin- und her." PRINT PRINT " Viele Funktionen k”nnen auch mit einer Taste aufgerufen werden." PRINT " (siehe im Men; der Aufw„rtspfeil steht fr eine gehaltene Shift-Taste.)" PRINT PRINT " Einige ntzliche Tastenfunktionen:" PRINT PRINT " Undo: letzte Žnderungen rckg„ngig machen." PRINT " Shift + Help: Hilfsbemerkungen aus- und einschalten." PRINT " Shift + B: Testbild" PRINT " F10: bestimmen, ob Figuren wie z.B. Kreise gefllt werden sollen." PRINT " Pfeiltasten: Zwischen den Bildern hin- und herschalten (5 Bilder m”glich)" PRINT PRINT " Viele Aktionen k”nnen sofort durch Bet„tigung der Taste [Backspace] rck-" PRINT " g„ngig gemacht werden (z.B. beim Freihandzeichnen, Radieren und Fllen)." PRINT PRINT " Falls mal keine Linien entstehen: Vielleicht ist die Zeichenfarbe auf weiž" PRINT " oder ein falscher Graphikmodus eingestellt ... Auch beim Schreiben von" PRINT " Texten kann der Wechsel des Graphikmodus manchmal ntzlich sein." REPEAT UNTIL MOUSEK>1 OR INKEY$<>"" SPUT menue$ RETURN PROCEDURE horizontal p%(0)=0 p%(2)=b% p%(4)=x% p%(6)=x%+b% p%(8)=3 p%(5)=y%+h% p%(7)=y%+h% FOR i%=0 TO h% p%(1)=i% p%(3)=i% BITBLT smfdb%(),dmfdb%(),p%() DEC p%(5) DEC p%(7) NEXT i% RETURN PROCEDURE inlines_einlesen ' In den folgenden Zeilen befindet sich das Maschinenprogramm zum Aus- und ' Einpacken von STAD-Bildern und das Titelbild. Wenn das Programm als ASCII- ' Datei gespeichert wird, verschwinden sie! Dann mssen die entsprechenden ' Dateien wieder in diese Zeilen eingeladen werden. ' INLINE stad_depack%,212 INLINE stad_h_pack%,214 INLINE stad_v_pack%,242 ' Das Titelbild wurde als gepacktes Bild eingebunden: INLINE titel%,13433 ' ' Die folgende Assembler-Routine zum Ein- und Auspacken ins IMG-Format ' stammt aus dem GFA Anwenderbuch von Schell/Weidle: ' INLINE img_pack%,958 ' ' Lupen-Routine aus Ostrowskis Buch; abgespeichert als Maschinencode INLINE lupe%,110 ' ' Bootsektor, wenn Mausvirus draufsitzt: INLINE mausvirus%,512 mausvirus$=SPACE$(512) BMOVE mausvirus%,VARPTR(mausvirus$),512 RETURN PROCEDURE invert SGET undo$ GRAPHMODE 3 DEFFILL 1,1,1 PBOX -1,-1,640,400 GRAPHMODE 1 DEFFILL 1,muster1%,muster2% SGET bild$ RETURN PROCEDURE kasten SGET undo$ ' IF hilfe! RESTORE help_kasten @hilfstext ENDIF help_kasten: DATA K„sten ziehen mit zwei Mausklicks DATA [LMT] DATA DATA Aufh”ren mit rechter Maustaste DATA * ' DEFMOUSE 7 REPEAT MOUSE x%,y%,k% UNTIL k% ' DO COLOR 1 DEFLINE 1,1,0,0 WHILE k%=0 MOUSE x%,y%,k% WEND EXIT IF k%>1 OR INKEY$=CHR$(27) @gummikasten EXIT IF abbruch! GRAPHMODE mode% IF stil%<7 DEFLINE stil%,1,2,2 ELSE DEFLINE 1+NOT (&X1010101010101010),1,2,2 ENDIF DEFFILL 1,muster1%,muster2% COLOR farbe% IF figurfuellen! PBOX x%,y%,x1%,y1% ELSE FOR i%=0 TO breite%-1 ! Schleife fr eckige K„sten EXIT IF (i%>x1%-x%) OR (i%>y1%-y%) ! bei dicken Linien BOX x%+i%,y%+i%,x1%-i%,y1%-i% NEXT i% ENDIF PAUSE 5 k%=0 LOOP SGET bild$ RETURN PROCEDURE koerper PAUSE 10 ' ALERT 2,"Was m”chtest Du zeichnen?",0,"Prisma|Pyramide|nichts",antw% merk$=bild$ IF antw%<3 @vieleck IF hilfe! SELECT antw% CASE 1 RESTORE help_koerper_1 CASE 2 RESTORE help_koerper_2 ENDSELECT @hilfstext ENDIF help_koerper_1: DATA "Zum Fertigzeichnen des Prismas" DATA "den Punkt ber der ersten Ecke" DATA "mit [LMT] festlegen" DATA DATA "[RMT] = alles wieder weg" DATA * help_koerper_2: DATA "Zum Fertigzeichnen des Pyramide" DATA "die Spitze mit [LMT] festlegen" DATA DATA "[RMT] = alles wieder weg" DATA * ' GRAPHMODE 3 DEFLINE 1,1,0,0 REPEAT MOUSE x%,y%,k% IF gitter! x%=INT((x%+x_weite%/2)/x_weite%)*x_weite% y%=INT((y%+y_weite%/2)/y_weite%)*y_weite% ENDIF LINE x%(1),y%(1),x%,y% PAUSE 2 LINE x%(1),y%(1),x%,y% UNTIL k% IF k%>1 bild$=merk$ ENDIF SPUT bild$ ' IF k%<2 GRAPHMODE mode% IF mode%=4 ! mit Graphikmodus 4 sieht das Ergebnis zu bl”d aus GRAPHMODE 1 ENDIF IF stil%<7 DEFLINE stil%,breite%,2,2 ELSE DEFLINE 1+NOT (&X1010101010101010),breite%,2,2 ENDIF COLOR farbe% ' SELECT antw% CASE 1 x1%=x%-x%(1) y1%=y%-y%(1) FOR j%=0 TO i% IF j%<>i% LINE x%(j%),y%(j%),x%(j%)+x1%,y%(j%)+y1% ENDIF ADD x%(j%),x1% ADD y%(j%),y1% NEXT j% ' IF NOT figurfuellen! POLYLINE i%,x%(),y%() ELSE DEFFILL 1,muster1%,muster2% POLYFILL i%,x%(),y%() ENDIF CASE 2 FOR j%=0 TO i% IF j%<>i% LINE x%(j%),y%(j%),x%,y% ENDIF NEXT j% ENDSELECT SGET bild$ ENDIF @bild_kurz_zeigen(100) ENDIF RETURN PROCEDURE kopieren SGET bild$(bild%) GET 0,0,639,399,merk$ @schreibkasten(60,305) PRINT AT(25,10);" Auf welches Bild soll Bild ";bild%' PRINT AT(25,11);" kopiert werden? " PRINT AT(25,12);" (bitte Zifferntaste) " PRINT AT(25,14);" Abbruch mit 0" REPEAT i$=INKEY$ EXIT IF i$="0" UNTIL VAL(i$)>0 AND VAL(i$)<6 IF i$<>"0" bild%=VAL(i$) ! neue Bildnummer ' @menu_aendern ' SPUT bild$(bild%) SGET undo$ PAUSE 30 PUT 0,0,merk$,p_mode% SGET bild$(bild%) SGET bild$ ENDIF RETURN PROCEDURE kreis SGET undo$ ' IF hilfe! RESTORE help_kreis @hilfstext ENDIF help_kreis: DATA Zuerst Mittelpunkt anklicken, DATA dann Radius der Kreise DATA mit Mausklick festlegen DATA DATA Letzen Kreis entfernen mit [Backspace] DATA DATA Aufh”ren mit rechter Taste DATA DATA * ' DEFMOUSE 7 REPEAT MOUSE x%,y%,k% UNTIL k% SPUT bild$ ' DO COLOR 1 DEFLINE 1,1,0,0 IF k%=0 REPEAT REPEAT MOUSE x%,y%,k% x$=UPPER$(INKEY$) UNTIL k% OR x$>"" IF x$=CHR$(8) SPUT merk$ ENDIF UNTIL x$="" ENDIF SGET merk$ EXIT IF k%>1 OR INKEY$=CHR$(27) @gummikreis EXIT IF abbruch! GRAPHMODE mode% IF stil%<7 DEFLINE stil%,breite%,2,2 ELSE DEFLINE 1+NOT (&X1010101010101010),2,2 ENDIF DEFFILL 1,muster1%,muster2% COLOR farbe% IF figurfuellen! PCIRCLE x%,y%,ABS(x1%-x%) ELSE CIRCLE x%,y%,ABS(x1%-x%) ENDIF PAUSE 5 k%=0 LOOP SGET bild$ RETURN PROCEDURE kurve SGET undo$ DEFMARK 1,4,10 ' @mauswarte IF hilfe! RESTORE help_kurve @hilfstext ENDIF help_kurve: DATA "Die Kurvenform wird durch" DATA "die vier Punkte festgelegt [LMT]" DATA DATA "[LMT] = Punkte setzen oder verschieben" DATA DATA "[Return] = Kurve nehmen" DATA DATA "[RMT]/[Esc] = fertig" DATA * ' DEFMOUSE 5 DO GRAPHMODE 1 SGET merk$ DEFLINE 1,1,0,0 FOR i%=0 TO 3 REPEAT MOUSE x%(i%),y%(i%),k% IF INKEY$=CHR$(27) k%=2 ENDIF EXIT IF k%=2 UNTIL k% @mauswarte POLYMARK i%+1,x%(),y%() POLYLINE i%+1,x%(),y%() EXIT IF k%=2 NEXT i% SPUT merk$ EXIT IF k%>1 GRAPHMODE 3 POLYMARK 4,x%(),y%() POLYLINE 4,x%(),y%() CURVE x%(0),y%(0),x%(1),y%(1),x%(2),y%(2),x%(3),y%(3) DO MOUSE x%,y%,k% i$=INKEY$ IF i$=CHR$(27) k%=2 ENDIF EXIT IF k%>1 EXIT IF i$=CHR$(13) IF k% i%=-1 IF ABS(x%-x%(0))<10 AND ABS(y%-y%(0))<10 i%=0 ENDIF IF ABS(x%-x%(1))<10 AND ABS(y%-y%(1))<10 i%=1 ENDIF IF ABS(x%-x%(2))<10 AND ABS(y%-y%(2))<10 i%=2 ENDIF IF ABS(x%-x%(3))<10 AND ABS(y%-y%(3))<10 i%=3 ENDIF IF i%>-1 HIDEM SPUT merk$ ' @mauswarte REPEAT MOUSE x%(i%),y%(i%),k% CURVE x%(0),y%(0),x%(1),y%(1),x%(2),y%(2),x%(3),y%(3) PAUSE 2 CURVE x%(0),y%(0),x%(1),y%(1),x%(2),y%(2),x%(3),y%(3) UNTIL k% SHOWM ' POLYMARK 4,x%(),y%() POLYLINE 4,x%(),y%() CURVE x%(0),y%(0),x%(1),y%(1),x%(2),y%(2),x%(3),y%(3) ' @mauswarte ENDIF ENDIF LOOP @mauswarte SPUT merk$ EXIT IF k%>1 GRAPHMODE mode% IF stil%<7 DEFLINE stil%,breite%,anfang%,ende% ELSE DEFLINE 1+NOT (&X1010101010101010),breite%,anfang%,ende% ENDIF CURVE x%(0),y%(0),x%(1),y%(1),x%(2),y%(2),x%(3),y%(3) LOOP SGET bild$ RETURN PROCEDURE laden SGET undo$ ' @datei_einstellen @fileselect_titel("Bild von der Diskette laden") ' IF hilfe! PRINT AT(2,24);"Wenn beim Aufruf ""Datei laden"" die Shift-Taste gehalten wird, hat man beim" PRINT AT(2,25);"Laden eine gr”žere Auswahl."; ENDIF ' suchpfad$=pfad$(bild%)+extension$ FILESELECT suchpfad$,dateiname$(bild%),auswahl$ dateiname$(bild%)="" IF LEN(auswahl$)>0 IF EXIST(auswahl$) ! Wenn Datei existiert, ' i%=RINSTR(auswahl$,".") IF i%>0 extension$=MID$(auswahl$,i%+1) ! Extension wird herausgelesen ENDIF laufwerk%=ASC(auswahl$)-64 ' OPEN "I",#1,auswahl$ ! dann ”ffnen ' IF extension$="PAC" ! STAD-gepacktes Format @stad_pac_laden SGET bild$ ' ELSE IF extension$="IMG" ! IMG-gepacktes Format @img_laden IF h%=400 AND w%=640 SPUT bild$ ELSE SPUT bild$ @einsetzen ENDIF ' ELSE IF LOF(#1)=32000 OR LOF(#1)=32034 ! PIC- oder PI3-Format IF LOF(#1)=32034 SEEK #1,34 ENDIF bild$=INPUT$(32000,#1) ' ELSE IF LOF(#1)<32000 ' ' al$="Das sieht nicht nach Bild aus!|Trotzdem versuchen?" ALERT 2,al$,2,"ja|nein",antw% IF antw%=1 CLS BLOAD auswahl$,XBIOS(2) SGET bild$ ENDIF ' ENDIF ' i%=RINSTR(auswahl$,"\") pfad$(bild%)=LEFT$(auswahl$,i%)+"*." ! neuer Pfadname wird gebaut dateiname$(bild%)=MID$(auswahl$,i%+1) ' ENDIF ' CLOSE ENDIF SPUT bild$ RETURN PROCEDURE linienwahl ! Nach dem Programm "DENISE" aus der "68000er" COLOR 1 GRAPHMODE 1 SGET merk$ @schreibkasten(60,305) BOUNDARY 1 DEFFILL 1,0,0 FOR i%=104 TO 168 STEP 32 ! 3 Auswahl-Kisten PBOX 170,i%,245,i%+31 NEXT i% PBOX 170,235,245,260 ! Fertig-Kiste mit dickem Rahmen PBOX 171,236,244,259 PBOX 172,237,243,258 ' PBOX 400,103,470,135 ! zwei Kisten rechts PBOX 400,213,470,245 ' PRINT AT(23,8);"Breite +" PRINT AT(23,10);"Breite -" PRINT AT(25,12);"Stil" PRINT AT(24,16);"Fertig" PRINT AT(52,8);"Anfang" PRINT AT(53,15);"Ende" PRINT AT(20,18);"Bitte aussuchen, wie Linien aussehen sollen" DO IF stil%<7 DEFLINE stil%,breite%,anfang%,ende% ELSE DEFLINE 1+NOT (&X1010101010101010),breite%,anfang%,ende% ENDIF PBOX 270,103,370,245 ! Kiste fr Probelinie LINE 320,125,320,225 ! Probelinie PRINT AT(45,15);breite% PRINT AT(61,8);anfang% PRINT AT(61,15);ende% REPEAT MOUSE x%,y%,k% i$=INKEY$ IF i$>"" k%=1 SELECT UPPER$(i$) CASE "A" x%=420 y%=120 CASE "E" x%=420 y%=220 CASE "S" x%=200 y%=180 CASE "+" x%=200 y%=110 CASE "-" x%=200 y%=140 CASE "F" x%=200 y%=250 DEFAULT k%=0 ENDSELECT ENDIF UNTIL k%=1 OR i$=CHR$(13) OR VAL(i$)>0 PAUSE 5 EXIT IF i$=CHR$(13) IF VAL(i$)>0 breite%=2*VAL(i$)-1 ENDIF ' IF x%>170 AND x%<245 AND k% ! linke Kisten angeklickt IF y%>104 AND y%<136 breite%=breite%+2 IF breite%>21 breite%=21 ENDIF ENDIF IF y%>136 AND y%<168 breite%=breite%-2 IF breite%<1 breite%=1 ENDIF ENDIF IF y%>168 AND y%<200 @mauswarte breite%=1 INC stil% IF stil%>7 stil%=1 ENDIF ENDIF ENDIF ' IF x%>400 AND x%<470 AND k% ! rechte Kisten angeklickt IF y%>103 AND y%<135 INC anfang% IF anfang%>2 anfang%=0 ENDIF ENDIF IF y%>213 AND y%<245 INC ende% IF ende%>2 ende%=0 ENDIF ENDIF ENDIF ' EXIT IF (y%>235 AND y%<260) AND (x%>170 AND x%<240) AND k% ! Ausstieg LOOP GRAPHMODE mode% @zweitschirm @schirm2 SPUT menue$ GRAPHMODE 1 DEFFILL 0,2,8 PBOX 81,365,159,399 ! weižer Kasten berdeckt Probelinien DEFTEXT 1,1,0,6 TEXT 116,370,"-" ! Probelinien im Men zeichnen DEFLINE 1,breite%,0,0 LINE 100,365,100,399 IF stil%<7 DEFLINE stil%,1,anfang%,ende% ELSE DEFLINE 1+NOT (&X1010101010101010),1,anfang%,ende% ENDIF LINE 140,365,140,399 SGET menue$ @schirm1 DEFFILL 1,muster1%,muster2% IF stil%<7 DEFLINE stil%,breite%,anfang%,ende% ELSE DEFLINE 1+NOT (&X1010101010101010),breite%,anfang%,ende% ENDIF COLOR farbe% SPUT merk$ RETURN PROCEDURE linienzug SGET undo$ IF hilfe! RESTORE help_linienzug @hilfstext ENDIF help_linienzug: DATA "Linienzug:" DATA DATA "Ecken einzeln mit" DATA "[LMT] setzen" ' DATA ' DATA "[Backspace] = zurcknehmen" DATA DATA "[RMT]/[Esc] = fertig" DATA * DEFMOUSE 7 REPEAT MOUSE x%,y%,k% i$=INKEY$ UNTIL k% OR i$=CHR$(27) @mauswarte IF gitter! x%=INT((x%+x_weite%/2)/x_weite%)*x_weite% y%=INT((y%+y_weite%/2)/y_weite%)*y_weite% ENDIF REPEAT EXIT IF k%>1 OR i$=CHR$(27) REPEAT COLOR 1 DEFLINE 1,1,0,0 GRAPHMODE 3 MOUSE x1%,y1%,k% i$=INKEY$ IF gitter! x1%=INT((x1%+x_weite%/2)/x_weite%)*x_weite% y1%=INT((y1%+y_weite%/2)/y_weite%)*y_weite% ENDIF LINE x%,y%,x1%,y1% PAUSE 3 LINE x%,y%,x1%,y1% UNTIL k% OR i$=CHR$(27) @mauswarte GRAPHMODE mode% IF stil%<7 DEFLINE stil%,breite%,anfang%,ende% ELSE DEFLINE 1+NOT (&X1010101010101010),breite%,anfang%,ende% ENDIF COLOR farbe% IF k%=1 LINE x%,y%,x1%,y1% ENDIF x%=x1% y%=y1% UNTIL k%>1 OR i$=CHR$(27) SGET bild$ RETURN PROCEDURE loeschen SGET undo$ ' al$="Soll Bild "+STR$(bild%)+"|gel”scht werden?" ALERT 2,al$,1,"ja|nein",antw% IF antw%=1 CLS SGET bild$ ENDIF RETURN PROCEDURE menue_einrichten ' HIDEM ~C:stad_depack%(L:XBIOS(2),L:titel%) ! Titelbild auspacken ' ' BSAVE "TITEL.PIC",XBIOS(2),32000 ! Titelbild als PIC-Datei abspeicherbar ' DEFTEXT 1,0,0,4 TEXT 400,10,"Version "+version$ TEXT 400,20,"vom" TEXT 400,30,datum$ TEXT 400,40,"public domain" ' DEFTEXT 1,0,0,6 TEXT 500,15,"Leertaste oder" TEXT 500,25,"rechte Maustaste:" TEXT 500,35,"Bild ansehen" GET 242,52,288,98,uhr$ SGET menue$ RETURN PROCEDURE mikroskop teilbild$="" merk$="" IF hilfe! RESTORE help_ausschnitt @hilfstext ENDIF help_ausschnitt: DATA "Bitte den Ausschnitt, der" DATA "vergr”žert werden soll," DATA mit der linken Maustaste anklicken. DATA * DEFLINE 1,1,0,0 DEFMOUSE 0 HIDEM REPEAT ! Ausschnitt auf dem grožen Bild bestimmen ' MOUSE x%,y%,k% IF x%>600 x%=600 ENDIF IF y%>360 y%=360 ENDIF IF MOUSEK=0 GRAPHMODE 3 BOX x%,y%,x%+39,y%+39 PAUSE 2 BOX x%,y%,x%+39,y%+39 ENDIF UNTIL k% SPUT bild$ @mauswarte x1%=640 ! Position aužerhalb des Bildschirms fr die y1%=0 ! Markierung des ersten Ausschnittes IF k%=1 SGET undo$ teilbild%=x%-140 ! x-Position des Teilbildes (halbe Bildgr”že) x%=140 IF teilbild%<0 x%=140+teilbild% teilbild%=0 ENDIF IF teilbild%>320 x%=x%+teilbild%-320 teilbild%=320 ENDIF ' GET teilbild%,0,teilbild%+319,399,teilbild$ ! Teilbild grapschen CLS PUT 0,0,teilbild$ ! links an den Rand setzen BOX x%-1,y%-1,x%+40,y%+40 ! Ausschnitt markieren GRAPHMODE 1 PUT 0,0,teilbild$ ! Teilbild noch einmal auf die linke Seite SETMOUSE 480,160 ' IF hilfe! RESTORE help_mikroskop @hilfstext ENDIF help_mikroskop: DATA "Im rechten Feld werden einzelne" DATA "Punkte des gew„hlten Ausschnittes" DATA "gesetzt oder gel”scht:" DATA DATA "[LMT] = Punkt setzen " DATA "[RMT] = Punkt l”schen" DATA DATA "Im linken Feld bei Bedarf" DATA "neuen Ausschnitt w„hlen" DATA DATA "Linke Shift-Taste halten" DATA "zeigt die Koordinaten" DATA DATA "Der Ausgang ist unten rechts" DATA * ' DO ' ' kleinen Ausschnitt einfangen ' IF k%=1 AND x%<=280 GRAPHMODE 3 BOX x1%-1,y1%-1,x1%+40,y1%+40 ! alte Markierung l”schen GET x%,y%,x%+40,y%+39,merk$ ! Ausschnitt grapschen ' VOID C:lupe%(L:VARPTR(merk$)+6,40,39,L:XBIOS(3)+40) ' BOX x%-1,y%-1,x%+40,y%+40 ! neuen Ausschnitt markieren x1%=x% y1%=y% DEFLINE 1,3,0,0 COLOR 1 GRAPHMODE 1 BOX 322,322,638,398 PRINT AT(50,22);"zurck zum ganzen Bild" DEFLINE 1,1,0,0 ENDIF ' WHILE MOUSEX>319 AND merk$>"" GRAPHMODE 1 SHOWM MOUSE a%,b%,k% IF b%<320 a1%=INT((a%-320)/8) ! Positionen der Pixel im Ausschnitt b1%=INT(b%/8) a2%=INT(a%/8)*8+1 ! Positionen der vergr”žerten Pixel b2%=INT(b%/8)*8 IF BIOS(11,-1) AND 3 ! Wenn Shift-Taste gehalten, PRINT AT(70,24);x1%+a1%+teilbild%'y1%+b1%'''; ! Koordinaten anzeigen ENDIF IF k%=1 COLOR 1 DEFFILL 1,2,8 PBOX a2%,b2%,a2%+6,b2%+6 ! vergr”žertes Pixel DRAW x1%+a1%,y1%+b1% ! Originalpixel setzen ENDIF IF k%=2 COLOR 0 DEFFILL 0,2,8 PBOX a2%,b2%,a2%+6,b2%+6 DRAW x1%+a1%,y1%+b1% ENDIF ENDIF EXIT IF b%>320 WEND EXIT IF k% AND a%>320 AND b%>330 REPEAT MOUSE x%,y%,k% IF x%<320 HIDEM IF x%>280 x%=280 ENDIF IF y%>360 y%=360 ENDIF IF MOUSEK=0 GRAPHMODE 3 BOX x%,y%,x%+39,y%+39 PAUSE 2 BOX x%,y%,x%+39,y%+39 ENDIF ENDIF UNTIL k% OR x%>319 SHOWM LOOP ' GRAPHMODE 3 BOX x1%-1,y1%-1,x1%+40,y1%+40 ! alte Markierung l”schen GET 0,0,319,399,teilbild$ SPUT bild$ PUT teilbild%,0,teilbild$ SGET bild$ SHOWM ENDIF RETURN PROCEDURE mirrorput(x%,y%,z%,s.%) IF DPEEK(s.%+4)>6 !nur wenn auch etwas da ist a%=LPEEK(s.%) b%=DPEEK(a%) h%=DPEEK(a%+2) smfdb%(0)=a%+6 smfdb%(1)=(b%+16) AND &HFFF0 smfdb%(2)=h%+1 smfdb%(3)=smfdb%(1)/16 smfdb%(5)=DPEEK(a%+4) dmfdb%(0)=XBIOS(3) dmfdb%(1)=640 dmfdb%(2)=400 dmfdb%(3)=40 dmfdb%(5)=1 ON z% GOSUB vertikal,horizontal ENDIF RETURN PROCEDURE moduswahl SGET merk$ DEFLINE 1,1,0,0 COLOR 1 modus$="" @schreibkasten(60,305) PRINT AT(20,6);"Bitte den Graphikmodus aussuchen!" PRINT AT(20,8);"Durch den Graphikmodus wird bestimmt, wie" PRINT AT(20,9);"Bilder bereinander gezeichnet werden:" DO BOUNDARY 1 GRAPHMODE 1 DEFFILL 0,2,8 FOR i%=1 TO 4 PBOX 180,132+i%*32,460,164+i%*32 BOX 180,132+i%*32,460,164+i%*32 NEXT i% PRINT AT(25,12);"Modus 1: berdecken" PRINT AT(25,14);"Modus 2: durchsichtig" PRINT AT(25,16);"Modus 3: invertiert" PRINT AT(25,18);"Modus 4: invertiert durchsichtig" DEFFILL 1,1,1 GRAPHMODE 3 PBOX 180,132+mode%*32,460,164+mode%*32 EXIT IF modus$<>"" DO MOUSE x%,y%,k% i$=INKEY$ EXIT IF (k%=1 AND x%>180 AND x%<460 AND y%>164 AND y%<292) OR ASC(i$)=13 EXIT IF VAL(i$)>0 AND VAL(i$)<5 LOOP EXIT IF ASC(i$)=13 OR modus$<>"" IF k%=1 AND x%>180 AND x%<460 AND y%>164 AND y%<292 mode%=INT((y%-132)/32) modus$=" "+STR$(mode%) ENDIF IF VAL(i$)>0 mode%=VAL(i$) modus$=" "+STR$(mode%) ENDIF LOOP ' ' Einstellen des Modus fr PUT ' SELECT mode% CASE 1 p_mode%=3 CASE 2 p_mode%=7 CASE 3 p_mode%=6 CASE 4 p_mode%=13 ENDSELECT ' PAUSE 10 @mauswarte @modus_eintragen SPUT merk$ GRAPHMODE mode% RETURN PROCEDURE modus_eintragen @zweitschirm @schirm2 SPUT menue$ GRAPHMODE 1 DEFTEXT 1,0,0,6 TEXT 402,390," "+STR$(mode%) SGET menue$ @schirm1 RETURN PROCEDURE musterwahl LOCAL m1%,m2%,nr& SGET merk$ CLS DEFMOUSE 3 GRAPHMODE 1 BOUNDARY TRUE mx%=0 my%=0 ni&=1 RESTORE musterdaten REPEAT READ m1%,m2% DEFFILL 1,m1%,m2% PBOX mx%,my%,mx%+80,my%+50 ADD mx%,80 INC ni& IF (ni& MOD 8)=1 mx%=0 ADD my%,50 ENDIF UNTIL ni&>38 DEFMOUSE 0 SHOWM nr&=0 REPEAT REPEAT MOUSE mx%,my%,mk& UNTIL mk& IF mk&=1 nr&=(my%\50)*8+mx%\80+1 ENDIF UNTIL (nr&>0 AND nr&<39) OR mk&=2 IF mk&=1 RESTORE musterdaten FOR ni&=0 TO nr&-1 READ muster1%,muster2% NEXT ni& ENDIF @mauswarte @zweitschirm @schirm2 SPUT menue$ DEFFILL 1,muster1%,muster2% PBOX 240,380,320,399 SGET menue$ @schirm1 SPUT merk$ musterdaten: DATA 2,1,2,2,2,3,2,4,2,5,2,6 DATA 2,7,2,8,2,9,2,10,2,11,2,12 DATA 2,13,2,14,2,15,2,16,2,17,2,18 DATA 2,19,2,20,2,21,2,22,2,23,2,24 DATA 3,1,3,2,3,3,3,4,3,5,3,6 DATA 3,7,3,8,3,9,3,10,3,11,3,12,4,1,0,0 RETURN ' PROCEDURE n_ecken ! Nach dem Programm "DENISE" aus der "68000er" SGET undo$ HIDEM SGET merk$ ' @schreibkasten(60,305) PRINT AT(22,8);"Regelm„žiges Vieleck" PRINT AT(22,11);"Bitte Anzahl der Ecken eingeben" PRINT AT(22,12);"(h”chstens 29; 0 = Abbruch)" PRINT AT(22,14);">_"; ' eck$="" abbruch!=FALSE DO i$=INKEY$ IF ASC(i$)>47 AND ASC(i$)<58 ! Eingabe muž Ziffer sein eck$=eck$+i$ PRINT CHR$(8);i$;"_"; ENDIF EXIT IF VAL(eck$)>2 OR eck$="0" LOOP SHOWM IF VAL(eck$)>2 PRINT CHR$(8);"-Eck" PAUSE 20 eck%=VAL(eck$) SPUT merk$ IF hilfe! RESTORE help_n_eck @hilfstext ENDIF help_n_eck: DATA "Regelm„žiges Vieleck:" DATA DATA "Erst Mittelpunkt festlegen" DATA "dann Umkreisgr”že w„hlen" DATA DATA Aufh”ren mit rechter Taste DATA * DEFMOUSE 7 DO DEFLINE 1,1,0,0 SHOWM WHILE k%=0 MOUSE x%,y%,k% WEND EXIT IF k%>1 OR INKEY$=CHR$(27) @gummikreis EXIT IF abbruch! GRAPHMODE mode% PLOT x%+radius%,y% IF stil%<7 DEFLINE stil%,breite%,2,2 ELSE DEFLINE 1+NOT (&X1010101010101010),breite%,2,2 ENDIF DEFFILL 1,muster1%,muster2% GRAPHMODE mode% COLOR farbe% IF figurfuellen!=FALSE FOR f#=0 TO 2*PI STEP (2*PI)/eck% DRAW TO x%+COS(f#)*radius%,y%+SIN(f#)*radius% NEXT f# DRAW TO x%+radius%,y% DEFFILL 1,muster1%,muster2% ELSE x%(0)=x%+radius% y%(0)=y% x%(eck%)=x%+radius% y%(eck%)=y% FOR f#=0 TO 2*PI STEP (2*PI)/eck% x%(INT(f#/((2*PI)/eck%)+0.5))=x%+COS(f#)*radius% y%(INT(f#/((2*PI)/eck%)+0.5))=y%+SIN(f#)*radius% NEXT f# POLYFILL eck%,x%(),y%() ENDIF @mauswarte k%=0 LOOP SGET bild$ ENDIF RETURN PROCEDURE neuer_ordner ' @fileselect_titel("Ordner auf der Diskette anlegen") FILESELECT "\*.*","",ordner$ IF ordner$>"" IF EXIST(ordner$) ALERT 3,"Es gibt schon eine Datei|mit diesem Namen!",1,"Abbruch",dummy% ELSE MKDIR ordner$ ! Ordner anlegen ENDIF ENDIF SPUT menue$ ordner$="" RETURN PROCEDURE pulldownmenue SELECT MENU(0) CASE 1 ' al$=" K R I T Z E L | das Pixelverbiegeprogramm" al$=al$+"| von Heiko Mller|Mozartstraže 17, 2905 Edewecht " ALERT 1,al$,1,"aha",dummy% CASE 11 abbruch!=TRUE CASE 13 @bootsektor(1) CASE 15 @schluss ENDSELECT MENU menue$() MENU OFF RETURN PROCEDURE radiergummi DEFMOUSE 5 SGET undo$ @mauswarte HIDEM IF hilfe! RESTORE help_radiergummi @hilfstext ENDIF help_radiergummi: DATA "zuerst durch Mausklick bestimmen," DATA "wie grož das Radiergummi sein soll" DATA * DEFLINE 1,1,2,2 SETMOUSE rbreite%,rhoehe% ! Maus zuerst auf alte Radiergummigr”že einstellen REPEAT GRAPHMODE 3 i$=INKEY$ MOUSE x%,y%,k% BOX 0,0,x%,y% PAUSE 2 BOX 0,0,x%,y% UNTIL k%<>0 OR INKEY$=CHR$(13) @mauswarte SPUT bild$ rbreite%=x% rhoehe%=y% SETMOUSE 0,0 DEFFILL 0,1,0 ' IF hilfe! RESTORE help_standard @hilfstext ENDIF DEFLINE 1,1,2,2 DEFFILL 0,2,8 GRAPHMODE 3 REPEAT MOUSE x%,y%,k% BOX x%,y%,x%+rbreite%,y%+rhoehe% PAUSE 1 BOX x%,y%,x%+rbreite%,y%+rhoehe% UNTIL MOUSEK SPUT bild$ ' DO GRAPHMODE 3 REPEAT MOUSE x%,y%,k% BOX x%,y%,x%+rbreite%,y%+rhoehe% PAUSE 1 BOX x%,y%,x%+rbreite%,y%+rhoehe% x$=UPPER$(INKEY$) UNTIL k% OR x$=CHR$(8) IF x$=CHR$(8) SPUT merk$ ENDIF SGET merk$ WHILE k%=1 GRAPHMODE 3 BOX x%,y%,x%+rbreite%,y%+rhoehe% PAUSE 1 BOX x%,y%,x%+rbreite%,y%+rhoehe% GRAPHMODE 1 MOUSE x%,y%,k% PBOX x%,y%,x%+rbreite%,y%+rhoehe% WEND EXIT IF k%>1 OR INKEY$=CHR$(27) LOOP IF stil%<7 DEFLINE stil%,breite%,anfang%,ende% ELSE DEFLINE 1+NOT (&X1010101010101010),breite%,anfang%,ende% ENDIF GRAPHMODE mode% DEFFILL 1,muster1%,muster2% COLOR farbe% SGET bild$ RETURN PROCEDURE rundkasten SGET undo$ DEFMOUSE 7 ' IF hilfe! RESTORE help_kasten @hilfstext ENDIF REPEAT MOUSE x%,y%,k% UNTIL k% @mauswarte ' DO COLOR 1 DEFLINE 1,1,0,0 WHILE k%=0 MOUSE x%,y%,k% WEND EXIT IF k%>1 OR INKEY$=CHR$(27) @gummikasten EXIT IF abbruch! GRAPHMODE mode% IF stil%<7 DEFLINE stil%,breite%,2,2 ELSE DEFLINE 1+NOT (&X1010101010101010),breite%,2,2 ENDIF DEFFILL 1,muster1%,muster2% COLOR farbe% IF figurfuellen! PRBOX x%,y%,x1%,y1% ELSE RBOX x%,y%,x1%,y1% ENDIF PAUSE 5 k%=0 LOOP SGET bild$ RETURN PROCEDURE schluss ON BREAK CONT ! damit keine Doppelabfrage erfolgt OUT 2,7 ' ALERT 2,"Soll die Arbeit mit diesem|Programm beendet werden?",2,"ja|nein",antw% IF antw%=1 SPOKE &H484,PEEK(&H484) OR 2 ! Tastaturklickwiederholung ein OUT 4,8 ! Maus einschalten ON ERROR CLOSE EDIT ENDIF ON BREAK GOSUB schluss SPOKE &H484,PEEK(&H484) AND NOT 2 ! Tastaturklickwiederholung aus RETURN PROCEDURE schreiben LOCAL i$,x%,x1%,y%,y1%,k%,schreib$ IF hilfe! RESTORE help_schreiben @hilfstext ENDIF help_schreiben: DATA Text tippen und jede Zeile mit [LMT] DATA an der gewnschten Stelle absetzen. DATA DATA Beim Abschluž der Zeile mit [Return] DATA wird automatisch eine neue Zeile DATA begonnen. DATA DATA [Clr] setzt die Schreibmarke nach DATA oben links in die Ecke. DATA DATA Mit [Help] l„žt sich die Textein- DATA stellung ver„ndern. DATA DATA Ende mit [RMT] DATA * SGET undo$ SGET merk$ @wahleinstellung DO DEFMOUSE 1 SHOWM REPEAT ! auf erste Eingabe warten (damit Maus st„ndig sichtbar) MOUSE x%,y%,k% i$=INKEY$ UNTIL i$>"" OR k% EXIT IF k%>1 HIDEM GOTO schreibmarke ! Sonst wird die erste Taste ignoriert ' REPEAT i$=INKEY$ MOUSE x%,y%,k% schreibmarke: ' IF i$>"" SELECT ASC(i$) CASE 0 ! Sondertaste i%=ASC(RIGHT$(i$,1)) SELECT i% CASE 71 ! Clr schreib$="" i$=CHR$(27) x%=10 y%=8+hoehe%(ho%) SETMOUSE x%,y% CASE 98 ! Help DEFMOUSE 0 MOUSE x1%,y1%,k% SETMOUSE 300,200 SHOWM SPUT merk$ ' @schriftwahl ' DEFMOUSE 1 HIDEM @wahleinstellung SETMOUSE x1%,y1% i$="" ENDSELECT k%=0 SPUT merk$ TEXT x%,y%,schreib$ CASE 8 ! Backspace IF LEN(schreib$) schreib$=LEFT$(schreib$,LEN(schreib$)-1) SPUT merk$ TEXT x%,y%,schreib$ ENDIF CASE 13 ! Return k%=1 CASE 27 ! Esc schreib$="" SPUT merk$ DEFAULT schreib$=schreib$+i$ TEXT x%,y%,schreib$ ENDSELECT ENDIF ' EXIT IF k% ' MOUSE x1%,y1%,k% ! prfen ob Maus bewegt IF x1%<>x% OR y1%<>y% SPUT merk$ TEXT x1%,y1%,schreib$ ENDIF ' UNTIL i$=CHR$(13) OR i$=CHR$(27) ' SPUT merk$ EXIT IF k%>1 IF LEN(schreib$) TEXT x%,y%,schreib$ SGET merk$ IF k%=1 schreib$="" ENDIF ENDIF ' IF i$=CHR$(13) ADD y%,hoehe%(ho%)+5 ! neue Zeile SETMOUSE x%,y% ENDIF ' @mauswarte LOOP SGET bild$ DEFMOUSE 1 RETURN PROCEDURE graphik_normal GRAPHMODE 1 COLOR 1 DEFLINE 1,1,2,2 RETURN @schreibkasten(60,305) PROCEDURE schreibkasten(y1%,y2%) @graphik_normal DEFFILL 1,2,8 PBOX 144,y1%+4,504,y2%+4 ! schwarzer Hintergrundkasten DEFFILL 0,2,8 PBOX 140,y1%,500,y2% ! weižer Kasten davor BOX 140,y1%,500,y2% ! Umrandung RETURN PROCEDURE schriftwahl ! Nach dem Programm "DENISE" aus der "68000er" LOCAL x%,y%,k%,i%,i$ GRAPHMODE 1 SGET merk$ @schreibkasten(60,305) DEFFILL 1,0,0 BOUNDARY 1 FOR y%=70 TO 230 STEP 32 PBOX 170,y%,270,y%+31 NEXT y% PBOX 300,230,340,260 ! OK-Box mit dickem Rand PBOX 301,231,339,259 PBOX 302,232,338,258 PRINT AT(25,6);"Normal" PRINT AT(25,8);"Fett" PRINT AT(25,10);"Hell" PRINT AT(25,12);"Kursiv" PRINT AT(25,14);"Unterstr." PRINT AT(25,16);"Umrandet" PRINT AT(40,16);"OK" PRINT AT(21,18);"Bitte die Schriftart fr Texte aussuchen" REPEAT FOR i%=8 TO 16 STEP 2 PRINT AT(23,i%);" " NEXT i% IF schriftart%>0 FOR i%=0 TO 4 IF schriftart% AND 2^i% PRINT AT(23,8+i%*2);">" ENDIF NEXT i% ENDIF GRAPHMODE 1 FOR y%=70 TO 160 STEP 32 PBOX 365,y%,460,y%+31 NEXT y% PRINT AT(49,6);"gr”žer" PRINT AT(49,8);"kleiner" PRINT AT(49,10);"drehen" PRINT AT(47,14);"Graphikmodus" ' PBOX 365,230,460,262 ! fr Graphikmodus DEFTEXT 1,0,0,13 TEXT 376,253," " LINE 430,230,430,262 LINE 395,230,395,262 PRINT AT(52,16);mode% PBOX 275,70,360,190 GRAPHMODE 2 DEFTEXT 1,schriftart%,wink%,hoehe%(ho%) TEXT 315,110,"Aa" TEXT 315,145,"01" REPEAT MOUSE x%,y%,k% i$=INKEY$ UNTIL k%=1 OR i$=CHR$(13) PAUSE 9 IF k%=1 IF x%>170 AND x%<270 AND y%>70 AND y%<262 ! linke Kastenreihe IF y%<102 schriftart%=0 ENDIF FOR i%=0 TO 4 IF y%>102+32*i% AND y%<134+32*i% IF schriftart% AND 2^i% SUB schriftart%,2^i% ELSE ADD schriftart%,2^i% ENDIF ENDIF NEXT i% ENDIF IF x%>365 AND x%<460 AND y%>70 AND y%<262 ! rechte Kastenreihe SELECT y% CASE 70 TO 102 IF ho%<4 INC ho% ENDIF CASE 103 TO 134 IF ho%>0 SUB ho%,1 ENDIF CASE 135 TO 166 ADD wink%,900 IF wink%>2700 wink%=0 ENDIF CASE 230 TO 262 SELECT x% CASE 365 TO 395 DEC mode% CASE 430 TO 460 INC mode% DEFAULT ENDSELECT SELECT mode% CASE 0,1 mode%=1 p_mode%=3 CASE 2 p_mode%=7 CASE 3 p_mode%=6 CASE 4,5 mode%=4 p_mode%=13 ENDSELECT PRINT AT(52,16);mode% ENDSELECT ENDIF ENDIF UNTIL x%>300 AND x%<340 AND y%>230 AND y%<260 OR i$=CHR$(13) ' @zweitschirm @schirm2 SPUT menue$ ! Im Men die Žnderungen eintragen GRAPHMODE 1 DEFFILL 0,2,8 PBOX 81,251,159,295 DEFTEXT 1,schriftart%,wink%,hoehe%(ho%) IF wink%=0 OR wink%=900 TEXT 120,290,"W" ELSE TEXT 120,270,"W" ENDIF DEFTEXT 1,0,0,4 GRAPHMODE 2 TEXT 90,260,"Schriftart" GRAPHMODE 1 DEFTEXT 1,0,0,6 TEXT 402,390," "+STR$(mode%) SGET menue$ @schirm1 ' @wahleinstellung SPUT merk$ RETURN PROCEDURE signum_einladen ' ' Einladen von SIGNUM!-Fonts als PUT-Graphiken ' ' aus GFA-Club-Nachrichten 1/2-89 Seite 24 ' SGET undo$ CLS abbruch!=FALSE auswahl$="" IF FRE(0)<80000 al$="Vorsicht! Beim Einladen|des Fonts kann es Speicher-" al$=al$+"|platzprobleme geben!|Bilder vorher abspeichern!" ALERT 1,al$,1,"zurck|egal",antw% IF antw%=1 abbruch!=TRUE ENDIF ENDIF IF NOT abbruch! ALERT 2,"Was fr ein Font soll|geladen werden?",2,"P9|P24|L30",antw% SELECT antw% CASE 1 ext$=".P9" faktor#=2.7 CASE 2 ext$=".P24" faktor#=4 CASE 3 ext$=".L30" faktor#=3.4 ENDSELECT @fileselect_titel("SIGNUM-Druckerfont einladen") FILESELECT laufwerk$+"*"+ext$,"",auswahl$ ENDIF IF auswahl$>"" AND RIGHT$(auswahl$)<>"\" i$=MID$(auswahl$,RINSTR(auswahl$,".")) IF ext$<>i$ ALERT 1,"Die Auswahl funktioniert|leider nicht!",1,"Abbruch",dummy% abbruch!=TRUE ELSE ' IF EXIST(auswahl$) ERASE z_propbr%() ERASE zeichen$() DIM z_propbr%(221),zeichen$(221) RESERVE 2*FRE(0)/3 prnt_ram%=HIMEM+4000 IF ODD(prnt_ram%) INC prnt_ram% ENDIF ' auswahl$=LEFT$(auswahl$,RINSTR(auswahl$,".")-1) ENDIF ' OPEN "i",#1,auswahl$+ext$ lof%=LOF(#1) CLOSE #1 BLOAD auswahl$+ext$,prnt_ram% !Druckerfont einladen IF EXIST(auswahl$+ext$) edit_ram%=prnt_ram%+lof%+2 IF ODD(edit_ram%) INC edit_ram% ENDIF BLOAD auswahl$+".E24",edit_ram% ELSE ALERT 1,"Der Editor-Font fehlt!",1,"Abbruch",dummy% RESERVE ! 3*FRE(0)/2 !Speicher freigeben abbruch!=TRUE ENDIF ENDIF ' IF NOT abbruch! GET 0,0,80,80,zeichen$(0) ! leeren Kasten fr Leerzeichen ' FOR i%=1 TO 127 ' offset_i%=LPEEK(prnt_ram%+140+i%*4) y_offset%=PEEK(prnt_ram%+652+offset_i%) z_hoehe%=PEEK(prnt_ram%+653+offset_i%) z_breite%=PEEK(prnt_ram%+654+offset_i%) ' offset_e%=LPEEK(edit_ram%+140+i%*4) z_propbr%(i%)=PEEK(edit_ram%+654+offset_e%) ' IF z_hoehe%>0 AND z_breite%>0 y_offset$=STRING$(y_offset%*(z_breite%-ODD(z_breite%)),0) ' IF ODD(z_breite%) zeichenbreite%=z_breite%-ODD(z_breite%) CLR b$,br_zaehl% FOR j%=1 TO z_hoehe% c$=STRING$(zeichenbreite%,0) BMOVE prnt_ram%+656+offset_i%+br_zaehl%,VARPTR(c$),zeichenbreite% b$=b$+c$ ADD br_zaehl%,z_breite% NEXT j% ELSE b$=STRING$(z_hoehe%*z_breite%,0) VOID FRE(0) BMOVE prnt_ram%+656+offset_i%,VARPTR(b$),z_hoehe%*z_breite% ENDIF b$=y_offset$+b$ ' zeichen$(i%)=MKI$(z_breite%*8-1)+MKI$(y_offset%+z_hoehe%-1)+MKI$(1)+b$ ' PUT 300,100,zeichen$(0) PUT 300,100,zeichen$(i%) ELSE zeichen$(i%)="" ENDIF NEXT i% ' z_propbr%(0)=z_propbr%(65) ! Breite des Leerzeichens wie beim "A" ' CLS ' RESTORE tauschdaten ' tauschdaten: DATA 64,129 DATA 93,132 DATA 125,142 DATA 91,148 DATA 123,153 DATA 92,154 DATA 127,158 DATA 1,123 DATA 2,125 DATA 15,91 DATA 16,93 DATA 32,221 DATA 0,32 ' REPEAT READ x%,y% zeichen$(y%)=zeichen$(x%) ! an ASCII-Codes anpassen z_propbr%(y%)=z_propbr%(x%) UNTIL x%=0 ' x%=100 y%=100 DATA 102,101,114,116,105,103,33,-1 DO READ z% ! "fertig" auf den Bildschirm schreiben EXIT IF z%<0 PUT x%,y%,zeichen$(z%),7 ADD x%,z_propbr%(z%)*faktor# LOOP RESERVE ! 3*FRE(0)/2 ! Speicher freigeben ' FOR i%=0 TO 31 ! die ersten 32 Zeichen l”schen zeichen$(i%)="" NEXT i% ' REPEAT UNTIL MOUSEK>1 OR INKEY$>"" signum!=TRUE ENDIF SPUT bild$ ENDIF RETURN PROCEDURE signum_schreiben ! Schreiben mit grožen SIGNUM-Zeichen IF NOT signum! ' ALERT 3,"Du hast noch keinen|SIGNUM-Zeichensatz geladen!",1,"ach ja",dummy% ELSE SGET undo$ REPEAT IF hilfe! RESTORE help_signum @hilfstext ENDIF help_signum: DATA "Zuerst auf dieser Seite schreiben." DATA DATA "Beenden mit [Esc] oder [RMT]." DATA DATA "Dann gewnschte Textteile ausschneiden" DATA "und an den richtigen Stellen einsetzen." DATA * CLS ' x%=0 y%=0 i$="" ' COLOR 1 DEFLINE 1,1,0,0 ' DO LINE x%+10,y%+1,x%+10,y%+z_hoehe%-1 ! Linie als Cursor REPEAT i%=ASC(INKEY$) IF MOUSEK>1 i%=27 ! rechte Maustaste imitiert Esc-Taste ENDIF UNTIL i%>0 ' IF i%>31 i$=i$+CHR$(i%) ! Kontrollstring (wird fr Backspace gebraucht) ENDIF ' COLOR 0 LINE x%+10,y%+1,x%+10,y%+z_hoehe%-1 ! Cursor weiž bermalen COLOR 1 ' EXIT IF i%=27 ' IF x%>550 AND (i%>31) ! Klingel am Zeilenende OUT 2,7 ENDIF ' IF i%=8 ! Backspace IF LEN(i$)>0 SUB x%,z_propbr%(ASC(RIGHT$(i$,1)))*faktor# PUT x%,y%,zeichen$(32) i$=LEFT$(i$,LEN(i$)-1) ENDIF ELSE ' PUT x%,y%,zeichen$(i%),7 ADD x%,z_propbr%(i%)*faktor# ' IF i%=13 ! Return x%=0 ADD y%,20*faktor# i$="" ! Kontrollstring l”schen ENDIF ' ENDIF IF y%>320 i%=27 ENDIF EXIT IF i%=27 LOOP ' UNTIL i%=27 ! Abbruch mit Esc (oder rechter Maustaste) SGET bild$ ENDIF RETURN PROCEDURE speicher_einrichten DIM menue$(30) RESTORE pulldowndaten i%=-1 DO INC i% READ menue$(i%) ' LPRINT i%''menue$(i%) EXIT IF menue$(i%)="***" LOOP menue$(i%)="" menue$(i%+1)="" ' pulldowndaten: ' DATA Kritzel , ber dies Programm DATA -------------------- DATA 1,2,3,4,5,6,"" DATA zurck, weiter im Programm,--------------------------- DATA Bootsektor A: untersuchen,---------------------------, Programmende,"" DATA *** ' DIM wert#(20),sektor#(20),text$(20),prozent#(20) ! fr Tortendiagramme DIM hoehe%(4) ! Buchstabenh”he DIM bild$(5) DIM pfad$(5),dateiname$(5) ! Pfade, beim Speichern von Bildern DIM t$(20) ! fr die Hilfstexte FOR i%=1 TO 5 bild$(i%)=bild$ ! fnf Bildschirme zum Wechseln NEXT i% bild%=1 ! Nummer des aktuellen Bildes DIM smfdb%(8),dmfdb%(8),p%(8) ! fr die Procedur "mirrorput" DIM x%(200),y%(200) ! fr Vielecke muster1%=2 muster2%=8 DEFFILL 1,muster1%,muster2% ! schwarz gitter!=FALSE ! aus farbe%=1 ! schwarz figurfuellen!=FALSE sprueh%=10 ! Radius fr Sprhdose mode%=1 modus$=" 1" p_mode%=3 ! Modus bei PUT (berschreiben) stil%=1 ! Liniendefinition breite%=1 anfang%=2 ende%=2 rbreite%=100 ! anf„ngliche Radiergummigr”že x_weite%=20 y_weite%=20 rhoehe%=50 RESTORE hoehe FOR i%=0 TO 4 READ hoehe%(i%) ! Schrifth”hen NEXT i% hoehe: DATA 4,6,13,20,32 ho%=2 ! Index fr Schrifth”hen wink%=0 ! Winkel fr Schriften extension$="PAC" laufwerk%=GEMDOS(25)+1 laufwerk$=CHR$(GEMDOS(25)+65)+":"+"\" FOR i%=1 TO 5 pfad$(i%)=laufwerk$+"*." dateiname$(i%)="TEST.PAC" NEXT i% pfad$=laufwerk$+"*." blockextension$="IMG" blockpfad$=laufwerk$+"*." blockname$="TEST.IMG" signum!=FALSE ! Kontrolle, ob SIGNUM-Font eingeladen bound%=1 ! 1 = gefllte Figuren mit Rand RETURN PROCEDURE speichern SGET undo$ ' IF hilfe! RESTORE help_bild_speichern @hilfstext help_bild_speichern: DATA "PAC-Bilder werden stark komprimiert" DATA "Verwendbar z.B. fr 'SIGNUM'" DATA DATA "IMG-Bilder werden weniger stark" DATA "aber schneller komprimiert" DATA "Verwendbar z.B. fr 'WORDPLUS'" DATA DATA "Nicht komprimierte (andere) Bildformate" DATA "ben”tigen viel Platz" DATA "Verwendbar z.B. fr BASIC" DATA DATA "Shift-Taste beim Speichern zeigt" DATA "wie stark gepackt wurde" DATA * @mauswarte SPUT bild$ ENDIF ' @fileselect_titel("Bild auf der Diskette speichern") ' $I+ ! Interrupt-Routinen ein (sonst bei "Diskette voll" Fehler) dummy%=5*9 ! code-erzeugende Anweisung (siehe Compiler-Buch Kap. 2.3.8) ' suchpfad$=pfad$(bild%)+extension$ FILESELECT suchpfad$,dateiname$(bild%),auswahl$ ' IF EXIST(auswahl$) OUT 2,7 ' al$="Datei unter diesem Namen ist|schon vorhanden!| |šberschreiben?" ALERT 2,al$,1,"ja|nein",antw% IF antw%=2 auswahl$="" ENDIF ' ENDIF IF LEN(auswahl$)>0 AND RIGHT$(auswahl$,1)<>"\" ! ausgenommen ist z.B. A:\ i%=RINSTR(auswahl$,".") IF i%gros% gros%=byte%(z%) ENDIF IF byte%(z%)kennbyte| IF byte%(z%)4 puf2$=SPACE$(LOF(#1)) b2_adr%=V:puf2$ BGET #1,b2_adr%,lof% HIDEM ~C:stad_depack%(L:XBIOS(2),L:b2_adr%) SHOWM ENDIF RETURN PROCEDURE speicherplatz PRINT AT(14,8);" Der Speicherplatz auf Laufwerk "+CHR$(laufwerk%+64)+" wird ermittelt. " frei%=DFREE(laufwerk%) ' al$="Speicherplatz auf " al$=al$+"Laufwerk "+CHR$(laufwerk%+64)+": | |"+STR$(frei%)+" Bytes " ALERT 1,al$,1,"aha",dummy% DEFMOUSE 3 RETURN PROCEDURE spiegeln ! die Proceduren spiegeln, mirrorput, vertikal und ' horizontal stammen alle aus dem GFA-BASIC-Buch von F. Ostrowski merk$=block$ ! alten Block merken (falls Abbruch) SGET undo$ GRAPHMODE 3 DEFLINE 1,1,0,0 HIDEM @ausschneiden IF b_breite%>0 ' al$="Wie willst Du spiegeln?" ALERT 2,al$,0,CHR$(4)+" "+CHR$(3)+"|"+CHR$(1)+" "+CHR$(2)+"|Abbruch",antw% @mirrorput(x%,y%,antw%,*block$) GET x%,y%,x1%,y1%,block$ SPUT bild$ IF antw%<3 @einsetzen ELSE block$=merk$ ENDIF ENDIF RETURN PROCEDURE spruehdose SGET undo$ HIDEM @zweitschirm @schirm2 PBOX -1,-1,640,400 ! gefllte Fl„che im Hintergrund @schirm1 ' IF hilfe! RESTORE help_spruehen @hilfstext HIDEM ENDIF help_spruehen: DATA linke Maustaste: Sprhen DATA DATA Letzten Sprhstož wieder weg: [Backspace] DATA DATA Gr”že „ndern: [E] DATA DATA rechte Taste: Aufh”ren DATA * GRAPHMODE 3 COLOR farbe% DEFLINE 1,1,0,0 REPEAT MOUSE x%,y%,k% CIRCLE x%,y%,sprueh% PAUSE 1 CIRCLE x%,y%,sprueh% x$=UPPER$(INKEY$) IF x$="E" SHOWM GRAPHMODE 1 @spruehdose_einstellen @schirm2 PBOX -1,-1,640,400 ! gefllte Fl„che im Hintergrund @schirm1 GRAPHMODE 3 HIDEM k%=0 ENDIF UNTIL MOUSEK SPUT bild$ ' DO GRAPHMODE 3 HIDEM REPEAT MOUSE x%,y%,k% CIRCLE x%,y%,sprueh% PAUSE 1 CIRCLE x%,y%,sprueh% x$=UPPER$(INKEY$) IF x$="E" SHOWM GRAPHMODE 1 @spruehdose_einstellen @schirm2 PBOX -1,-1,640,400 ! gefllte Fl„che im Hintergrund @schirm1 GRAPHMODE 3 HIDEM k%=0 ENDIF UNTIL k% OR x$=CHR$(8) IF x$=CHR$(8) SPUT merk$ ENDIF SGET merk$ EXIT IF k%>1 OR INKEY$=CHR$(27) GRAPHMODE 1 WHILE k%=1 MOUSE x%,y%,k% ' winkel%=RANDOM(360) radius%=RANDOM(sprueh%) x1%=x%+COSQ(winkel%)*radius% y1%=y%+SINQ(winkel%)*radius% ' @schirm2 ! auf dem Zweitschirm Farbe des Punktes ermitteln z%=POINT(x1%,y1%) @schirm1 ' IF x1%>-1 AND x1%<640 ! sonst werden Punkte am anderen Rand gesetzt PSET x1%,y1%,z% ! Punkt setzen ENDIF ' WEND EXIT IF k%>1 OR INKEY$=CHR$(27) LOOP IF stil%<7 DEFLINE stil%,breite%,anfang%,ende% ELSE DEFLINE 1+NOT (&X1010101010101010),breite%,anfang%,ende% ENDIF GRAPHMODE 1 SGET bild$ RETURN PROCEDURE spruehdose_einstellen spruehstart: SGET merk$ @schreibkasten(60,305) PRINT AT(29,7);"Einstellung der Sprhdose" PRINT AT(35,13);"- OK + "; PRINT AT(29,10);"Radius: ";sprueh%'; BOX 260,180,380,210 BOX 300,180,340,210 BOX 301,181,339,209 PRINT AT(29,16);"Sprhmuster:" DEFFILL 1,muster1%,muster2% PBOX 340,230,380,260 GRAPHMODE 3 CIRCLE 350,150,sprueh% REPEAT MOUSE x%,y%,k% IF k%=1 AND y%>230 AND y%<260 AND x%>340 AND x%<380 ! Muster „ndern SPUT merk$ @musterwahl @zweitschirm @schirm2 PBOX -1,-1,640,400 ! gefllte Fl„che im Hintergrund ??? wozu ??? @schirm1 GOTO spruehstart ENDIF IF k%=1 AND y%>180 AND y%<210 CIRCLE 350,150,sprueh% IF x%>260 AND x%<300 SUB sprueh%,1 PAUSE 2 IF sprueh%=1 sprueh%=2 ENDIF ENDIF IF x%>340 AND x%<380 ADD sprueh%,1 PAUSE 2 IF sprueh%=31 sprueh%=30 ENDIF ENDIF CIRCLE 350,150,sprueh% PRINT AT(29,10);"Radius: ";sprueh%'; ENDIF EXIT IF INKEY$=CHR$(13) UNTIL (x%>300 AND x%<340 AND y%>180 AND y%<210 AND k%=1) @zweitschirm @schirm2 SPUT menue$ DEFTEXT 1,0,0,6 GRAPHMODE 1 TEXT 562,390," "+STR$(sprueh%)+" " SGET menue$ @schirm1 SPUT merk$ COLOR farbe% GRAPHMODE mode% DEFFILL 1,muster1%,muster2% @mauswarte RETURN PROCEDURE strahlen SGET undo$ IF hilfe! RESTORE help_strahlen @hilfstext ENDIF help_strahlen: DATA Ausgangspunkt der Strahlen DATA mit [LMT] w„hlen DATA DATA Strahlen mit [LMT] setzen DATA DATA Abbruch mit [RMT] DATA * DEFMOUSE 7 COLOR 1 REPEAT MOUSE x%,y%,k% UNTIL k% IF gitter! x%=INT((x%+x_weite%/2)/x_weite%)*x_weite% y%=INT((y%+y_weite%/2)/y_weite%)*y_weite% ENDIF @mauswarte SPUT bild$ REPEAT EXIT IF k%>1 OR INKEY$=CHR$(27) GRAPHMODE 3 DEFLINE 1,1,0,0 REPEAT MOUSE x1%,y1%,k% IF gitter! x1%=INT((x1%+x_weite%/2)/x_weite%)*x_weite% y1%=INT((y1%+y_weite%/2)/y_weite%)*y_weite% ENDIF LINE x%,y%,x1%,y1% PAUSE 3 LINE x%,y%,x1%,y1% UNTIL k% GRAPHMODE mode% IF stil%<7 DEFLINE stil%,breite%,anfang%,ende% ELSE DEFLINE 1+NOT (&X1010101010101010),breite%,anfang%,ende% ENDIF COLOR farbe% EXIT IF k%>1 OR INKEY$=CHR$(27) LINE x%,y%,x1%,y1% @mauswarte UNTIL k%>1 SGET bild$ RETURN PROCEDURE stauchung ! Diese Procedure entwickelte Thilo Jantz, Portsloge ' @ausschneiden IF NOT abbruch! @zweitschirm ' IF b_breite%*b_hoehe%>0 ' al$="Wie soll die Blockgr”že|ver„ndert werden?" ALERT 2,al$,1,"1 : 1|verzerrt",antw% CLS PUT 0,0,block$ DEFLINE 1,1,0,0 BOX 0,0,b_breite%,b_hoehe% GRAPHMODE 3 PRINT AT(30,25);"Stauchungsfaktoren x / y: "; REPEAT MOUSE x%,y%,k% ' IF antw%=1 y%=b_hoehe%*x%/b_breite% ENDIF ' BOX 0,0,x%,y% PAUSE 2 BOX 0,0,x%,y% xstauch#=ROUND(x%/b_breite%,2) IF antw%=1 ystauch#=xstauch# ELSE ystauch#=ROUND(y%/b_hoehe%,2) ENDIF PRINT AT(62,25);xstauch#''''; PRINT AT(70,25);"/"'ystauch#'''; UNTIL k% ENDIF GRAPHMODE mode% ' IF k%=1 ! -------------------- nun geht's los: a%=XBIOS(2) ' xstauch#=1/xstauch# ystauch#=1/ystauch# ' black%=1 IF xstauch#>=1.5 OR ystauch# @schreibkasten(60,305) PRINT AT(24,6);"Bitte Schw„rzungstiefe fr die" PRINT AT(24,7);"Verkleinerung aussuchen:" PRINT AT(24,8);"(je gr”žer, desto schw„rzer)" PRINT AT(25,15); j%=xstauch#+1 IF ystauch#>xstauch# j%=ystauch#+1 ENDIF IF j%>9 j%=9 ENDIF GRAPHMODE 2 FOR i#=1 TO j% PRINT STR$(i#)''; BOX 160+i#*24,220,184+i#*24,245 EXIT IF i#>9 NEXT i# REPEAT SHOWM MOUSE x%,y%,k% black%=VAL(INKEY$) IF k% AND x%>184 AND x%<184+j%*24 AND y%>220 AND y%<245 black%=INT((x%-160)/24) ENDIF UNTIL black%>0 AND black%<=j% PRINT '''black% PAUSE 20 ENDIF ' @schirm2 ! Der Block wird im Hintergrund gelesen CLS PUT 0,0,block$ @schirm1 CLS ' IF xstauch#=1 x%=b_breite% GOTO stauchung_y ENDIF ' IF xstauch#>1 ! --- Verkleinern: X --- ' x%=-1 z%=0 i#=0 i%=0 ' WHILE i#1 ! --- Verkleinern: Y --- ' y%=-1 z%=0 i#=0 i%=0 ' WHILE i#20 OR anzahl%<0 OUT 2,7 ENDIF UNTIL anzahl%<21 AND anzahl%>=0 ' IF anzahl%>1 text!=FALSE ' ALERT 2,"Soll Text eingeblendet werden?",1,"ja|nein",antw% IF antw%=1 text!=TRUE ENDIF ' IF text! groesse%=6 ' ALERT 2,"Klein- oder Normalschrift?",1,"klein|normal",antw% IF antw%=2 groesse%=13 ENDIF prozent!=TRUE ' ALERT 2,"Sollen Prozents„tze|eingeblendet werden?",1,"ja|nein",antw% IF antw%=2 prozent!=FALSE ENDIF ENDIF ' CLS PRINT PRINT " Bitte die einzelnen Werte mit [Return] eingeben (zuerst einen grožen)" PRINT PRINT " Nr. Wert "; IF text! PRINT "Text dazu (max. 15 Zeichen)" ENDIF PRINT FOR i%=1 TO anzahl% PRINT AT(2,i%+4); PRINT USING "###",i%; PRINT ":"; NEXT i% FOR i%=1 TO anzahl% PRINT CHR$(27);"e" ! Cursor einschalten w$="" DO PRINT AT(8,i%+4);w$'; PRINT CHR$(27);"D"; ! Cursor um ein Zeichen nach links REPEAT i$=INKEY$ UNTIL i$<>"" EXIT IF ASC(i$)=13 AND VAL(w$)>=0 IF ASC(i$)=8 AND LEN(w$) w$=LEFT$(w$,LEN(w$)-1) ELSE IF INSTR("0123456789.",i$)>0 w$=w$+i$ ELSE OUT 2,7 ENDIF ENDIF LOOP wert#(i%)=VAL(w$) IF w$="" PRINT "0" ENDIF PRINT CHR$(27);"f" ! Cursor ausschalten IF text! PRINT AT(25,i%+4); FORM INPUT 15,text$(i%) ENDIF NEXT i% ' Prozentverteilung ermitteln: sum#=0 FOR i%=1 TO anzahl% sum#=sum#+wert#(i%) NEXT i% IF sum#=0 ' al$="so eine bescheuerte Eingabe!!| | (insgesamt Null??)" ALERT 3,al$,1,"au weia",dummy% SPUT bild$ ELSE BOUNDARY 1 FOR i%=1 TO anzahl% prozent#(i%)=wert#(i%)*100/sum# sektor#(i%)=prozent#(i%)*36 ! 1% entspricht 36 * 1/10 Grad NEXT i% ' ' Kreis und Muster zeichnen ' CLS IF hilfe! RESTORE help_torte @hilfstext ENDIF help_torte: DATA Mit Maus die Gr”že der Torte bestimmen DATA DATA šbernehmen mit Mausklick DATA * DEFLINE 1,1,0,0 HIDEM x%=320 y%=200 IF gitter! x%=INT((x%+x_weite%/2)/x_weite%)*x_weite% y%=INT((y%+y_weite%/2)/y_weite%)*y_weite% ENDIF GRAPHMODE 3 PAUSE 10 REPEAT MOUSE x1%,y1%,k% IF gitter! x1%=INT((x1%+x_weite%/2)/x_weite%)*x_weite% y1%=INT((y1%+y_weite%/2)/y_weite%)*y_weite% ENDIF radius%=ABS(x1%-x%) CIRCLE x%,y%,radius% PAUSE 2 CIRCLE x%,y%,radius% UNTIL k%=1 CLS ' x1%=320-radius% ! x-Werte zum Ausschneiden der fertigen Torte IF x1%<0 x1%=0 ENDIF x2%=320+radius% IF x2%>639 x2%=639 ENDIF ' start%=900 GRAPHMODE 1 DEFLINE 1,1,0,0 COLOR 1 FOR i%=1 TO anzahl% schluss%=start%+sektor#(i%) DEFFILL 1,2,i% IF prozent#(i%)<2 ! Da nicht beliebig kleine Sektoren gezeichnet ausgleich%=50 ! werden k”nnen, werden die ganz kleinen Sektoren ELSE ! zu grož dargestellt. Durch šberdecken vom ausgleich%=0 ! n„chsten Sektor wird der Winkel wieder richtig. ENDIF PCIRCLE x%,y%,radius%,start%,schluss%+ausgleich% start%=schluss% NEXT i% ' DEFFILL 1,2,1 PCIRCLE x%,y%,radius%,900,900+sektor#(1) ! den ersten Sektor noch einmal, ' damit der evtl. zu grože letzte ' berdeckt wird ' CIRCLE x%,y%,radius% ! Auženkreis als Begrenzung ' IF text! ' die Texte werden in die Kreissektoren geschrieben: ' DEFTEXT 1,0,0,groesse% ' ' richtung#=900 ! Startwinkel in 1/10 Grad PRINT AT(1,22); FOR i%=1 TO anzahl% richtung#=richtung#+sektor#(i%)/2 gradrichtung#=richtung#/10 ! Textrichtung in Grad bogenrichtung#=gradrichtung#*PI/180 ! Textrichtung in Bogenmaž textx%=x%+(radius%-10)*COS(bogenrichtung#) texty%=y%-(radius%-10)*SIN(bogenrichtung#) ' IF prozent! text$(i%)=text$(i%)+" ("+STR$(INT(prozent#(i%)+0.5))+"%)" ENDIF ' IF textx%640-(LEN(text$(i%))*8) textx%=640-(LEN(text$(i%))*8) ENDIF ' TEXT textx%,texty%,text$(i%) ! Text schreiben ' x-Werte anpassen an berstehenden Text IF textx%x2% x2%=textx%+(LEN(text$(i%))*8) ENDIF ' richtung#=richtung#+sektor#(i%)/2 NEXT i% ENDIF ' y%=200-radius% IF y%<0 y%=0 ENDIF y1%=200+radius% IF y1%>399 y1%=399 ENDIF GET x1%,y%,x2%,y1%,block$ SPUT bild$ @einsetzen ENDIF ' SGET bild$ SHOWM ENDIF RETURN PROCEDURE ueber GRAPHMODE 1 CLS PRINT PRINT " K R I T Z E L - ein pixelorientiertes Malprogramm" PRINT PRINT " Version ";version$'"vom"'datum$;"" PRINT PRINT PRINT " Programmiert in GfA-BASIC 3.5 von" PRINT PRINT " Heiko Mller, Mozartstraže 17, 2905 Edewecht" PRINT PRINT PRINT " Es darf mitsamt der Programmliste (Amerika-Fans sagen dazu auch source code)" PRINT " beliebig kopiert oder weitergegeben werden." PRINT PRINT " Falls jemand das Programm verbessert oder einen Fehler findet und beseitigt," PRINT " m”ge er bitte eine Diskette mit der ver„nderten Version an die obige Anschrift" PRINT " schicken. Als ""Dankesch”n"" werden auch gerne Disketten mit anderen GFA-BASIC-" PRINT " Programmen angenommen. Wenn aužerdem ein frankierter Rckumschlag beigefgt" PRINT " ist, kommt die Diskette mit der neuesten Version von ""Kritzel"" zurck." PRINT REPEAT UNTIL MOUSEK>1 OR INKEY$<>"" SPUT menue$ RETURN PROCEDURE umriss ! aus GFA-CLUB Nachrichten 5/89 S. 22 HIDEM SGET undo$ IF hilfe! RESTORE help_umriss @hilfstext ENDIF help_umriss: DATA "Umriss:" DATA DATA "Von allen schwarzen Fl„chen" DATA "bleiben nur" DATA "die Auženlinien stehen." DATA * ' GET 0,0,639,399,merk$ ' al$="Welche Umrižart wnscht Du?|innen in der Fl„che entlang," al$=al$+"|aužen leicht oder|voll um die Fl„che herum?" ALERT 2,al$,1,"innen|leicht|voll",antw% SELECT antw% CASE 1 PUT 0,0,merk$ GRAPHMODE 3 DEFFILL 1,1 PBOX 0,0,639,399 GET 0,0,639,399,bild$ GRAPHMODE 1 CLS FOR i%=-1 TO 1 FOR j%=-1 TO 1 PUT i%,j%,bild$,7 NEXT j% NEXT i% PUT 0,0,merk$,1 CASE 2 PUT 0,0,merk$ PUT -1,0,merk$,7 PUT 1,0,merk$,7 PUT 0,1,merk$,7 PUT 0,-1,merk$,7 PUT 0,0,merk$,6 CASE 3 FOR i%=-1 TO 1 FOR j%=-1 TO 1 PUT i%,j%,merk$,7 NEXT j% NEXT i% PUT 0,0,merk$,6 ENDSELECT ' SGET bild$ SHOWM RETURN PROCEDURE version ! TOS-Version und -Datum (aus ST-Computer Nr. 6/90 Seite 176) ' adresse%=(LPEEK(&H4F2)) ! Anfangsadresse des Betriebssystem-Heders ' tosversion$=HEX$(DPEEK(adresse%+2)) ! Versionsnummer des TOS im BCD-Format tosversion$=LEFT$(tosversion$,1)+"."+RIGHT$(tosversion$,1) ' PRINT tosversion$ ' i$=HEX$(LPEEK(adresse%+24)) ! TOS-Erstellungsdatum im BCD-Format erstelldatum$=MID$(i$,LEN(i$)-5,2)+"."+MID$(i$,1,LEN(i$)-6)+"."+RIGHT$(i$,4) ' PRINT " vom ";erstelldatum$ RETURN PROCEDURE vertikal p%(1)=0 p%(3)=h% p%(5)=y% p%(7)=y%+h% p%(8)=3 p%(4)=x%+b% p%(6)=x%+b% FOR i%=0 TO b% p%(0)=i% p%(2)=i% BITBLT smfdb%(),dmfdb%(),p%() DEC p%(4) DEC p%(6) NEXT i% RETURN PROCEDURE vieleck SGET undo$ IF hilfe! RESTORE help_hole_vieleck @hilfstext ENDIF help_hole_vieleck: DATA "Vieleck:" DATA DATA "Ecken einzeln mit" DATA "[LMT] setzen" DATA ' DATA "[Backspace] = zurcknehmen" ' DATA DATA "[RMT]/[Esc] = fertig" DATA DATA "Die letzte Ecke wird mit" DATA "der ersten automatisch" DATA "verbunden" DATA * DEFMOUSE 5 DO FOR i%=1 TO 200 IF i%=1 DO MOUSE x%(1),y%(1),k% IF gitter! x%(1)=INT((x%(1)+x_weite%/2)/x_weite%)*x_weite% y%(1)=INT((y%(1)+y_weite%/2)/y_weite%)*y_weite% ENDIF i$=INKEY$ EXIT IF i$=CHR$(27) OR k% LOOP INC i% ENDIF ' EXIT IF i$=CHR$(27) OR k%>1 GRAPHMODE 3 DEFLINE 1,1,0,0 REPEAT MOUSE x%(i%),y%(i%),k% i$=INKEY$ IF gitter! x%(i%)=INT((x%(i%)+x_weite%/2)/x_weite%)*x_weite% y%(i%)=INT((y%(i%)+y_weite%/2)/y_weite%)*y_weite% ENDIF LINE x%(i%-1),y%(i%-1),x%(i%),y%(i%) PAUSE 5 LINE x%(i%-1),y%(i%-1),x%(i%),y%(i%) UNTIL k% OR i$=CHR$(27) GRAPHMODE 3 EXIT IF k%>1 OR i$=CHR$(27) LINE x%(i%-1),y%(i%-1),x%(i%),y%(i%) @mauswarte NEXT i% @mauswarte GRAPHMODE mode% x%(0)=x%(i%-1) y%(0)=y%(i%-1) IF stil%<7 DEFLINE stil%,breite%,2,2 ELSE DEFLINE 1+NOT (&X1010101010101010),breite%,2,2 ENDIF COLOR farbe% IF NOT figurfuellen! POLYLINE i%,x%(),y%() ELSE DEFFILL 1,muster1%,muster2% POLYFILL i%,x%(),y%() ENDIF EXIT IF auswahl%<>45 AND scan%<>64 ! Wenn K”rper gezeichnet werden REPEAT MOUSE x%,y%,k% x$=UPPER$(INKEY$) UNTIL k% OR x$=CHR$(8) OR x$=CHR$(27) IF x$=CHR$(8) SPUT merk$ ENDIF EXIT IF k%>1 OR x$=CHR$(27) SGET merk$ LOOP SGET bild$ RETURN PROCEDURE zeitanzeige DEFTEXT 1,0,0,4 TEXT 250,90,TIME$ ! aktuelle Uhrzeit anzeigen SHOWM RETURN PROCEDURE zweitschirm ! Platz fr zweiten Bildschirm machen: ' a%=XBIOS(3) ! Adresse des logischen Bildschirms ' ERASE bild%(),bild2%() DIM bild%(64255/4) ! Platz fr 2 Bildschirme (braucht das Assembler-Programm) DIM bild2%(64255/4)! noch zwei weitere dazu (zum Aus- und Einpacken) b1_adr%=(VARPTR(bild%(0))+255) AND &HFFFF00 ! macht Adresse durch 256 teilbar b2_adr%=(VARPTR(bild2%(0))+255) AND &HFFFF00 ' RETURN ' PROCEDURE schirm1 ~XBIOS(5,L:a%,L:-1,-1) ! normalen Schirm aktivieren RETURN ' PROCEDURE schirm2 ~XBIOS(5,L:b1_adr%,L:-1,-1) ! Zweitschirm aktivieren RETURN ' PROCEDURE img_laden LOCAL t# @zweitschirm LOCAL z%,xb% ' BGET #1,b2_adr%,LOF(#1) ' ' IMG-Header abfragen: ' w%=DPEEK(b2_adr%+12) ! Bildbreite h%=DPEEK(b2_adr%+14) ! Bildh”he ' ' Aufruf des Assembler-Programmes, wobei gilt: ' 1 = Einpacken - 2 = Auspacken ' b1_adr und b2_adr die Adressen der Grafikinformation sind ' w% und h% sind die Dimensionen der Ursprungsgrafik in Pixel ' Rckgabewert fehler%=0, wenn alles OK ' t#=TIMER ' fehler%=C:img_pack%(2,L:b1_adr%,L:b2_adr%,w%,h%) ' t#=(TIMER-t#)/200 IF BIOS(11,-1) AND 3 al$="Grafik ausgepackt|in "+STR$(t#)+" Sekunden.|" al$=al$+"w="+STR$(w%)+" h="+STR$(h%) ALERT 1,al$,1,"aha",dummy% ENDIF ' IF fehler%<>0 ALERT 1,"Fehler beim Auspacken|der IMG-Datei aufgetreten!",1,"Mist",dummy% ENDIF ' ' Das Bild wird angezeigt, auch wenn ein Fehler aufgetreten ist: ' IF w%<>640 ! wenn das Bild nicht so breit ist wie der Bildschirm ' xb%=(w%+7) DIV 8 BMOVE b1_adr%,b2_adr%,32000 ' ' Bildspeicher putzen; putz berfssigerweise auch screen: ' leer$=STRING$(1280,0) FOR i%=0 TO 49 ! Achtung! kein einziges Byte weiter! BMOVE V:leer$,ADD(b1_adr%,MUL(i%,1280)),1280 NEXT i% ' z%=b1_adr% FOR n%=0 TO h%-1 BMOVE b2_adr%,z%,xb% ADD b2_adr%,xb% ADD z%,80 NEXT n% ' ENDIF ' IF h%>400 ! Bild auf Bildschirmgr”že (SM124) zurechtschneiden h%=400 ENDIF IF w%>640 w%=640 ENDIF ' @schirm2 IF h%=400 AND w%=640 SGET bild$ ELSE GET 0,0,w%,h%,block$ ! Bild auf dem Zweitschirm einfangen ENDIF @schirm1 ' RETURN ' PROCEDURE img_einpacken(w%,h%) LOCAL t#,z% ' ' b1_adr und b2_adr sind die Adressen der Grafikinformation ' w% und h% sind die Dimensionen der Ursprungsgrafik in Pixel ' Rckgabewert z%=L„nge der gepackten Datei ' t#=TIMER ' z%=C:img_pack%(1,L:b2_adr%,L:b1_adr%,w%,h%) ' t#=(TIMER-t#)/200 IF BIOS(11,-1) AND 3 prozent%=z%/320 al$="Grafik gepackt"+STR$(z%)+" Byte ("+STR$(prozent%)+"%)|" al$=al$+STR$(t#)+" Sekunden." ALERT 1,al$,1,"aha",dummy% ENDIF ' BPUT #1,b2_adr%,z% ' RETURN PROCEDURE mauswarte ! Warten, bis Maustaste losgelassen wird WHILE MOUSEK WEND RETURN PROCEDURE warte_m_t ! Mausbewegung oder Taste abwarten LOCAL x%,y%,k% MOUSE x%,y%,k% REPEAT UNTIL ABS(MOUSEX-x%)>10 OR ABS(MOUSEY-y%)>10 OR INKEY$<>"" RETURN PROCEDURE hilfstext LOCAL i%,sicher$ GET 140,20,504,399,sicher$ FOR i%=1 TO 20 READ t$(i%) EXIT IF t$(i%)="*" NEXT i% ' @schreibkasten(20,50+16*i%) FOR i%=1 TO 20 EXIT IF t$(i%)="*" PRINT AT(22,i%+3);t$(i%) NEXT i% ERASE t$() DIM t$(20) ' @warte_m_t PUT 140,20,sicher$ @wahleinstellung RETURN PROCEDURE get.tom !Taste oder Maustaste abliefern (nicht warten) MOUSE x%,y%,k% KEYTEST key% taste%=BIOS(11,-1) ! Umschalttasten anfragen IF key% scan%=AND(key%,&HFF0000)\&HFFFF @no.key k%=0 ELSE scan%=0 ENDIF RETURN PROCEDURE no.key !Tastaturpuffer l”schen LPOKE XBIOS(14,1)+6,0 RETURN PROCEDURE uhr ! von der Diskette zu Ostrowskis GFA-BASIC-Buch LOCAL m_x%,m_y%,size%,uhrx%,uhry%,sek#,min#,std#,t%,dd$,k% @zweitschirm @schirm2 PUT 242,52,uhr$ m_x%=265 m_y%=75 size%=23 sek#=VAL(MID$(TIME$,7))*PI/30 min#=VAL(MID$(TIME$,4))*PI/30+sek#/60 std#=VAL(TIME$)*PI/6+min#/12 COLOR 1 DEFLINE 1,1,0,0 LINE m_x%,m_y%,m_x%+size%/2*SIN(std#),m_y%-size%/2*COS(std#) LINE m_x%,m_y%,m_x%+(size%-size%/10)*SIN(min#),m_y%-(size%-size%/10)*COS(min#) DEFLINE 1+NOT (&X1010101010101010),1,0,0 LINE m_x%,m_y%,m_x%+size%*SIN(sek#),m_y%-size%*COS(sek#) GET 242,52,288,98,uhr_neu$ @schirm1 PUT 242,52,uhr_neu$ monat: DATA Jan,Feb,M„r,Apr,Mai,Jun,Jul,Aug,Sep,Okt,Nov,Dez RESTORE monat FOR i%=1 TO VAL(MID$(DATE$,4,3)) READ monat$ NEXT i% DEFTEXT 1,0,0,4 TEXT 295,60,LEFT$(DATE$,3) TEXT 295,67,monat$ TEXT 292,77,RIGHT$(DATE$,4) RETURN PROCEDURE bootsektor(x1%) ' aus "SCRUTINIZER" ' Programm zur Kontrolle des Bootsektors (post_industrial 1991) ' CLS antw%=0 IF x1%=1 ALERT 1,"Achtung! Wenn keine Diskette|in Laufwerk A liegt, kann|man nicht mehr weiterarbeiten!",1,"OK|Abbruch",antw% ENDIF IF antw%=1 b$=SPACE$(512) ! Platz fr Bootsektor adr%=VARPTR(b$) r%=BIOS(4,2,L:adr%,1,0,0) ! Bootsektor einlesen ELSE r%=1 ENDIF ' IF r%<>0 IF x1%=1 ALERT 0,"|Bootsektorberprfung|hat nicht geklappt! ",1,"aha",r% ENDIF ELSE s%=0 ! Checksumme initialisieren FOR i%=0 TO 511 STEP 2 ! Checksumme bilden ADD s%,DPEEK(adr%+i%) s%=s% MOD 65536 ! Ab 65536 wieder von vorn NEXT i% IF x1%=1 ! Wenn vom Programm aus aufgerufen, Bootsektor anzeigen @normaleinstellung PBOX 54,35,586,230 BOX 55,36,585,229 BOX 57,38,583,227 LINE 57,80,583,80 IF s%=&H1234 i$="Der Bootsektor enth„lt ein ausfhrbares Programm." ELSE i$="Kein ausfhrbares Programm im Bootsektor." ENDIF TEXT 64,65,i$ x%=64 y%=100 DEFTEXT 1,0,0,6 FOR i%=0 TO 511 TEXT x%,y%,CHR$(PEEK(adr%+i%)) x%=x%+8 IF x%>574 THEN y%=y%+16 x%=64 ENDIF NEXT i% ENDIF ' IF s%=&H1234 ! Ausfhrbarer Bootsektor? ' x%=0 FOR i%=1 TO 448 ! Der Mausvirus hat eine L„nge von 448 Bytes IF INSTR(b$,MID$(mausvirus$,i%,1)) INC x% ENDIF NEXT i% PRINT AT(2,24);x% IF x%>430 ! 430 von 448 šbereinstimmungen ' virus!=TRUE @alarm al$="Auf dieser Diskette sitzt|vermutlich der Mausvirus!!" al$=al$+"|Computer sofort ausschalten|und zuerst Diskette ausmisten!" ALERT 3,al$,1,"Sch...",antw% ENDIF ENDIF ENDIF RETURN PROCEDURE alarm FOR i%=1 TO 10 OUT 2,7 PAUSE 3 NEXT i% RETURN