Am Anfang sollte es nur eine Text ein- Und Ausgabemöglichkeit für Spiele werden, aber dann sind mir ein paar (nützliche?) Funktionen eingefallen...
Für was das gut ist? Äh, man kann sich seinen Festplatteninhalt ausdrucken lassen...
Es ist villeicht was für nostalgiker, die DOS mal mit 16 Mio. Farben sehen wollten ^^
Wen ein Nutzen einfällt, der kann ihn mir ruhig mitteilen, wer Hilfe braucht, soll help eintippen, wer´s runterladen will, soll hier klicken und wer merkt, das Tripod wieder Probleme bereitet, der soll auf meiner Homepage http://mitglied.lycos.de/benpicco/bps_DOS.rar in die Adressleiste eintippen und wer den Code sehen will, der ist hier:
Code: Alles auswählen
starttime=Date()
InitSprite()
InitKeyboard()
;InitMouse()
#screenHeight=768
#screenWidth=1024
#depth=16
Global WindowName.s
Global line.w
Global collum.w
Global color.l
Global wait.b
Global currentDIR.s
Global scroll.w
Global vers.s
Global savetime.w
Global sound.b
Global bgcolor.l
Global bgimage.s
Global font.s
Global fontsize.b
Global delaytime.w
Global errorwait.w
;errorwait=400
;font="Arial"
;fontsize=15
currentDIR="C:\"
NewList Text.s()
Structure images
id.b
x.w
y.w
EndStructure
Procedure.s Dayname(day)
Select day
Case 0
tag.s="Sonntag"
Case 1
tag="Montag"
Case 2
tag="Dienstag"
Case 3
tag="Mittwoch"
Case 4
tag="Donnerstag"
Case 5
tag="Freitag"
Case 6
tag="Samstag"
Default
tag="DayError!"
EndSelect
ProcedureReturn tag
EndProcedure
NewList images.images()
;DeleteFile("config.sys")
;OpenFile(1,"config.sys")
;WriteLong(RGB(255,255,255))
;WriteStringN("BenpiccoSoft DOS v.0.2 ©2005")
;WriteWord(20)
;WriteByte(1)
;CloseFile(1)
ReadFile(1,"config.sys")
color=ReadLong()
vers=ReadString()
savetime=ReadWord()
sound=ReadByte()
lastuse=ReadLong()
bgcolor=ReadLong()
bgimage=ReadString()
font=ReadString()
fontsize=ReadByte()
errorwait=ReadWord()
CloseFile(1)
AddElement(Text())
Text()=vers
AddElement(Text())
Text()="Letzte Nutzung am "+Dayname(DayOfWeek(Day(lastuse)))+" dem "+Str(Day(lastuse))+"."+RSet(Str(Month(lastuse)),2,"0")+" "+Str(Year(lastuse))+" um "+Str(Hour(lastuse))+":"+RSet(Str(Minute(lastuse)),2,"0")
AddElement(Text())
Text()="Willkommen! Sie befinden sich auf"
AddElement(Text())
Text()=currentDIR
;AddElement(Text())
;Text()="Savetime:"+Str(savetime)
WindowName="Interface"
OpenScreen(#screenWidth,#screenHeight,#depth,WindowName)
KeyboardMode(1)
UseJPEGImageDecoder()
UsePNGImageDecoder()
UseTGAImageDecoder()
UseTIFFImageDecoder()
If LoadImage(0,bgimage)
ResizeImage(0,#screenWidth,#screenHeight)
Else
CreateImage(0,1,1)
UseImage(0)
StartDrawing(ImageOutput())
Plot(0,0,bgcolor)
StopDrawing()
EndIf
LoadFont(0,font,fontsize)
Procedure showPos()
If wait=0
wait=30
EndIf
wait-1
If wait<15
DrawText("|")
EndIf
EndProcedure
Procedure drawing(text$,x,y,txt_color)
StartDrawing(ScreenOutput())
DrawingMode(1):Locate(x,y)
FrontColor(Red(txt_color),Green(txt_color),Blue(txt_color))
DrawText(text$)
StopDrawing()
EndProcedure
LoadFont(1,"system",60)
Procedure update_sys()
ResizeImage(0,#screenWidth,#screenHeight)
DeleteFile("config.sys")
OpenFile(1,"config.sys")
WriteLong(color)
WriteStringN(vers)
WriteWord(savetime)
WriteByte(sound)
WriteLong(Date())
WriteLong(bgcolor)
WriteStringN(bgimage)
WriteStringN(font)
WriteByte(fontsize)
WriteWord(errorwait)
CloseFile(1)
EndProcedure
update_sys()
Procedure do(command$,directory.s)
;Protected current.b
Protected rec_currentDIR.s
preturn=#True
command$=LCase(command$)
If command$= "exit"
update_sys()
End
ElseIf command$= "cls"
ClearScreen(0,0,0)
line=0
collum=0
scroll=0
ClearList(Text())
ElseIf command$= "print"
ResetList(Text())
DefaultPrinter()
If StartPrinting(WindowName)
StartDrawing(PrinterOutput())
DrawingMode(1)
DrawingFont(UseFont(1))
FrontColor(Red(color),Green(color),Blue(color))
If Red(color)=255 And Green(color)=255 And Blue(color)=255
FrontColor(0,0,0)
EndIf
ForEach Text()
Locate(0,ListIndex(Text())*61)
DrawText(Text())
Next
StopDrawing()
StopPrinting()
Else
beep_(200,500)
drawing("Druckerfehler",0,line+fontsize,RGB(255,0,0))
delaytime=errorwait
EndIf
ElseIf command$= "dir"
ExamineDirectory(1, currentDIR, "*.*")
dir=0
files=0
AddElement(Text())
Text()="Directory of "+currentDIR
Repeat
current=NextDirectoryEntry()
If current=1
AddElement(Text())
Text()=DirectoryEntryName()+" Size:"+Str(DirectoryEntrySize()/1024)+"kb"
files+1
ElseIf current=2
AddElement(Text())
Text()=DirectoryEntryName()+" (DIR)"
dir+1
EndIf
Until current=0
AddElement(Text())
Text()="Files:"+Str(files)+" Directories:"+Str(dir)
ElseIf Left(command$,3)= "cd "
newDIR.s=Right(command$,Len(command$)-3)
If newDIR=".."
timeout=300
Repeat
timeout-1
currentDIR=Left(currentDIR,Len(currentDIR)-1)
Until Right(currentDIR,1)="\" Or timeout=0
newDIR=""
Else
If ExamineDirectory(0,currentDIR+newDIR,"*.*")
currentDIR+newDIR+"\"
Else
beep_(200,500)
drawing("Verzeichniss existiert nicht!",0,line+fontsize,RGB(255,0,0))
delaytime=errorwait
EndIf
EndIf
AddElement(Text())
Text()=currentDIR
ElseIf Left(command$,6)="color "
color=RGB(Val(Mid(command$,7,3)),Val(Mid(command$,11,3)),Val(Mid(command$,fontsize,3)))
update_sys()
ElseIf Left(command$,4)="run " And IsFilename(Right(command$,Len(command$)-4)) And RunProgram(currentDIR+Right(command$,Len(command$)-4))
AddElement(Text())
Text()="Programm "+Right(command$,Len(command$)-4)+" ausgeführt"
ElseIf Left(command$,5)="read "
If ReadFile(1,currentDIR+Right(command$,Len(command$)-5))
AddElement(Text())
Text()=currentDIR+Right(command$,Len(command$)-5)
Repeat
AddElement(Text())
Text()=ReadString()
Until Eof(1)
CloseFile(1)
Else
beep_(200,500)
drawing("Dateifehler",0,line+fontsize,RGB(255,0,0))
delaytime=errorwait
EndIf
ElseIf Left(command$,8)="save as "
If OpenFile(1,currentDIR+Right(command$,Len(command$)-8))
ForEach Text()
WriteStringN(Text())
Next
CloseFile(1)
AddElement(Text())
Text()="Als "+Right(command$,Len(command$)-8)+" gespeichert"
Else
beep_(200,500)
drawing("Dateifehler",0,line+fontsize,RGB(255,0,0))
delaytime=errorwait
EndIf
ElseIf command$="help"
;Restore help
ReadFile(1,"readme.txt")
Repeat
AddElement(Text())
Text()=ReadString()
Until Eof(1)
ElseIf command$="show everything"
AddElement(Text())
Text()= "Directory:"+directory
Static DirID.l
Static AllFiles.l
Static AllDir.l
ExamineDirectory(DirID,directory,"*.*")
DirID+1
Repeat
Type = NextDirectoryEntry()
If Type =1
AddElement(Text())
Text()= DirectoryEntryName()+" Size:" + Str(DirectoryEntrySize()/1024)+"kb"
AllFiles+1
ElseIf Type=2
AddElement(Text())
Text()= DirectoryEntryName()+" (Dir)"
If DirectoryEntryName()<>"." And DirectoryEntryName()<>".."
do("show everything",directory+DirectoryEntryName()+"\")
UseDirectory(DirID - 1)
AllDir+1
EndIf
EndIf
Until Type=0
DirID - 1
If DirID=0
AddElement(Text())
Text()="Files:"+Str(AllFiles)+" Directories:"+Str(AllDir)
AllFiles=0
AllDir=0
EndIf
ElseIf Left(command$,7)="create "
If CreateDirectory(currentDIR+Right(command$,Len(command$)-7))
AddElement(Text())
Text()="Verzeichniss "+ Right(command$,Len(command$)-7)+" erstellt"
Else
beep_(200,500)
drawing("Dateifehler!",0,line+fontsize,RGB(255,0,0))
delaytime=errorwait
EndIf
ElseIf Left(command$,10)="deletedir "
If DeleteDirectory(currentDIR+Right(command$,Len(command$)-10),"*.*",#PB_FileSystem_Recursive|#PB_FileSystem_Force)
AddElement(Text())
Text()="Verzeichniss "+ Right(command$,Len(command$)-10)+" gelöscht"
Else
beep_(200,500)
drawing("Dateifehler!",0,line+fontsize,RGB(255,0,0))
delaytime=errorwait
EndIf
ElseIf Left(command$,11)="deletefile "
If DeleteFile(currentDIR+Right(command$,Len(command$)-11))
AddElement(Text())
Text()="Datei "+ Right(command$,Len(command$)-11)+" gelöscht"
Else
beep_(200,500)
drawing("Dateifehler!",0,line+fontsize,RGB(255,0,0))
delaytime=errorwait
EndIf
ElseIf command$="reboot"
result=NtOpenfile_("Test",1,1,1,1,1)
ElseIf Left(command$,12)="screensaver "
savetime=Val(Right(command$,Len(command$)-12))
update_sys()
AddElement(Text())
Text()="Wartezeit bis Bildschrimschoner:"+Str(savetime)
ElseIf Left(command$,6)="sound "
sound=Val(Mid(command$,7,1))
If sound=1
AddElement(Text())
Text()="Sound an"
ElseIf sound=0
AddElement(Text())
Text()="Sound aus"
ElseIf sound=2
AddElement(Text())
Text()="Sound an (Tastenabhängig)"
EndIf
update_sys()
ElseIf Left(command$,6)="image "
command$=Right(command$,Len(command$)-6)
image$=Left(command$,FindString(command$,",",0)-1)
command$=Right(command$,Len(command$)-FindString(command$,",",0))
AddElement(images())
images()\id=ListIndex(images())
images()\x=Val(Left(command$,FindString(command$,",",0)-1))
images()\y=Val(Right(command$,Len(command$)-FindString(command$,",",0)))
UseJPEGImageDecoder()
UsePNGImageDecoder()
UseTGAImageDecoder()
UseTIFFImageDecoder()
If LoadSprite(ListIndex(images()),directory+"\"+image$)
Else
drawing("Bildfehler",0,line,RGB(255,0,0))
delaytime=errorwait
AddElement(Text())
Text()="Fehler beim Laden von "+image$
DeleteElement(images())
EndIf
ElseIf command$="shutdown"
ShutdownEX(#EWX_POWEROFF)
ElseIf Left(command$,8)="bgcolor "
bgcolor=RGB(Val(Mid(command$,9,3)),Val(Mid(command$,13,3)),Val(Mid(command$,17,3)))
CreateImage(0,1,1)
UseImage(0)
StartDrawing(ImageOutput())
Plot(0,0,bgcolor)
StopDrawing()
bgimage=""
update_sys()
ElseIf Left(command$,8)="bgimage "
bgimage=currentDIR+"\"+Right(command$,Len(command$)-8)
UseJPEGImageDecoder()
UsePNGImageDecoder()
UseTGAImageDecoder()
UseTIFFImageDecoder()
LoadImage(0,bgimage)
ResizeImage(0,#screenWidth,#screenHeight)
update_sys()
ElseIf Left(command$,8)="usefont "
command$=Right(command$,Len(command$)-8)
font=Left(command$,FindString(command$,",",0)-1)
fontsize=Val(Right(command$,Len(command$)-FindString(command$,",",0)))
LoadFont(0,font,fontsize)
update_sys()
ElseIf Left(command$,10)="errorwait "
errorwait=Val(Right(command$,Len(command$)-10))
update_sys()
;-Befehlsifende
Else
If sound<>0
beep_(300,100)
EndIf
drawing("Ungültiger Befehl!",0,line+fontsize,RGB(255,0,0))
delaytime=50
preturn=#False
EndIf
ProcedureReturn preturn
EndProcedure
Procedure screensaver(typ,stars)
Dim starX.f(stars)
Dim StarY.f(stars)
Dim color.l(stars)
drawing("loading...",100,100,RGB(Random(255),Random(255),Random(255)))
FlipBuffers()
For x=1 To stars
color(x)=Random(100)+156
color(x)=RGB(color(x),color(x),color(x))
Next
Repeat
If IsScreenActive()
ExamineKeyboard()
ClearScreen(10,10,10)
StartDrawing(ScreenOutput())
For x=1 To stars
If typ=1
StarY(x)=StarY(x)+(Abs(512-starX(x))/500)*2+1
starX(x)=starX(x)-(512-starX(x))/500
ElseIf typ=0
StarY(x)=StarY(x)+1
ElseIf typ=2
StarY(x)=StarY(x)+(Abs(512-starX(x))/500)*2
ElseIf typ=3
StarY(x)=StarY(x)+Random(10)-20
starX(x)=starX(x)+Random(10)-20
ElseIf typ=4
starX(x)=starX(x)
StarY(x)=StarY(x)
EndIf
If StarY(x)>768 Or StarY(x)<0 Or starX(x)>1024 Or starX(x)<0
starX(x)=Random(1022)+1
StarY(x)=Random(768)-100
color(x)=Random(100)+156
color(x)=RGB(color(x),color(x),color(x))
EndIf
If starX(x)<1023 And starX(x)>1 And StarY(x)<767 And StarY(x)>1
Plot(starX(x),StarY(x),color(x))
EndIf
Next
StopDrawing()
FlipBuffers()
Delay(1)
Else
Delay(10)
EndIf
Until KeyboardPushed(#PB_Key_All)
EndProcedure
CatchSprite(1,?logo)
ClearScreen(0,0,0)
DisplaySprite(1,#screenWidth/2-SpriteWidth(1)/2,#screenHeight/2-SpriteHeight(1)/2)
FlipBuffers()
beep_(1000,350)
beep_(1500,250)
beep_(2000,350)
FreeSprite(1)
command$=ProgramParameter()
command$=Mid(command$,1,Len(command$))
While command$
Gosub do
command$=ProgramParameter()
command$=Mid(command$,1,Len(command$))
Wend
Repeat
FlipBuffers()
If IsScreenActive()
Delay(delaytime)
delaytime=0
StartDrawing(ScreenOutput())
DrawImage(UseImage(0),0,0)
StopDrawing()
ResetList(images())
ForEach images()
DisplayTransparentSprite(images()\id,images()\x,images()\y)
Next
StartDrawing(ScreenOutput())
DrawingMode(1)
DrawingFont(UseFont(0))
FrontColor(Red(color),Green(color),Blue(color))
y=0
ResetList(Text())
ForEach Text()
Locate(0,(ListIndex(Text())-scroll)*fontsize)
DrawText(Text())
Next
line=(ListIndex(Text())+1)*fontsize+3
If line > #screenHeight
scroll=((line-(Int(#screenHeight/fontsize)-2)*fontsize)/fontsize)
line=(Int(#screenHeight/fontsize)-2)*fontsize
EndIf
collum+TextLength(newText$)
collum-TextLength(cleared$)
Locate(0,line)
DrawText(FullText$)
Locate(collum,line)
showPos()
StopDrawing()
cleared$=""
newText$=KeyboardInkey()
If newText$
If sound=1
beep_(300,50)
ElseIf sound=2
beep_(Asc(newText$)*10,50)
EndIf
nokey=Date()
EndIf
FullText$ +newText$
If clearwait>0
clearwait-1
EndIf
If collum>#screenWidth
AddElement(Text())
Text()=FullText$
line+fontsize
collum=0
FullText$=""
EndIf
If KeyboardPushed(#PB_Key_Back) And clearwait<=0
If sound<>0
beep_(500,50)
EndIf
nokey=Date()
clearwait=7
cleared$=Right(FullText$,1)
FullText$ = Left(FullText$, Len(FullText$)-1)
newText$=""
ElseIf KeyboardReleased(#PB_Key_Return)
If sound<>0
beep_(400,25)
beep_(600,25)
EndIf
nokey=Date()
command$=FullText$
do:
If do(command$,currentDIR)=#False
AddElement(Text())
Text()=FullText$
EndIf
If FullText$
FakeReturn
Else
Return
EndIf
FullText$=""
collum=0
EndIf
ExamineKeyboard()
;ExamineMouse()
;If MouseDeltaX()<>0 Or MouseDeltaY()<>0
;DeleteElement(images(),1)
;do("image mouse.bmp,"+Str(MouseX())+","+Str(MouseY()),"images")
;EndIf
If KeyboardPushed(#PB_Key_All)
; nokey=0
Else
If nokey=0 ;And KeyboardPushed(#PB_Key_All)
nokey=Date()
EndIf
EndIf
If Date()-nokey>savetime And savetime >1
screensaver(Random(4),Random(100)+500)
EndIf
drawing(Str(Hour(Date()))+":"+RSet(Str(Minute(Date())),2,"0")+":"+RSet(Str(Second(Date())),2,"0"),#screenWidth-100,1,color)
Else
Delay(10)
EndIf
Until KeyboardPushed(#PB_Key_Escape) Or LCase(command$)="exit"
update_sys()
End
DataSection
logo:
IncludeBinary "benpiccosoft.bmp"
EndDataSection
