PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

Eine Art DOS, leider bisher ohne Nutzen...

https://www.purebasic.fr/german/viewtopic.php?t=4395

Seite 1 von 2

Eine Art DOS, leider bisher ohne Nutzen...

Verfasst: 15.08.2005 17:35
von benpicco
Man könnte fast meinen, ich hätte ein Betriebssystem mit PureBasic gemacht, einzuger haken ist, das es nur unter Windows läuft :lol:
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

Verfasst: 15.08.2005 18:11
von nicolaus
ganz lustig doch würde ich gern das gepipe weg haben und dann geht shift+. (also das ich nen doppelpunkt bekomme) oder auch altgr+ß (für ein \) nich.

Verfasst: 15.08.2005 19:54
von MVXA
Ist ja richtig süß ^^.
Was du vielleicht noch einbauen könntest wäre sowas wie ein Byte
Interpreter. Dann hättest du auch sowas wie ein eigenes Programm-
format.

edit:
Und vielleicht könntest du ja noch eine andere Schrift nutzen (wie
Fixedsys oder sowas). Hauptsache eine Blockschrift. Dann wäre es
noch praktisch, wenn diese kleine rote Fehlermeldung länger da
stehen würde.

Verfasst: 16.08.2005 18:06
von benpicco
@nicolaus: Das Gepiepe kann man mit sound 0 ausstellen (es kommt noch besser, etzwichen piept es schon bei jeder Taste, je nach ascii code unterschiedlich ^^, villeicht lässt sich ein Musikprogramm draus machen)
Das mit den Sonderzeichen ist wohl so ein Problem mit keyboardinkey...
Byte Interpreter? Äh, ist das sowas wie ne Batch Datei? Wenn ja, könnte es schon über die Parameter funktionieren...
Das mit der Schriftart lässt sich machen, am besten zum selbstauswählen (usefont Arial,32 fiele mir da ein, mach ich am besten gleich mal...)

Verfasst: 16.08.2005 20:00
von MVXA

Code: Alles auswählen

    org 100h

    jmp display_message
    mov [message+1],'i'
    mov ax,word [message+5]
    mov word [message+2],ax

display_message:
    mov ah,9
    mov dx,message
    int 21h
    mov ax,4C00h
    int 21h

message db 'Hello!',24h
Das dann durch einen von dir selbst geschriebenen Assembler
jagen, der aus dem Zeugs Bytes macht. Dann durch dein Programm
interpretieren lässt, wäre das ein Byte Interpreter. Du kannst für
diese Zwecke natürlich auch Easy nutzen. Such einfach mal hier
im Feedback Forum danach :freak:

Verfasst: 16.08.2005 20:12
von DarkDragon
:lol: Ja tolles gepiepse, aber da greif ich lieber auf ne GUI zurück wie WinModern oder :mrgreen: eventuell auch Win 3.11 oder wie das heißt. :roll:

Verfasst: 24.08.2005 17:12
von shadow
ähm, link funzt net. will auch mal gucken :?

Verfasst: 24.08.2005 17:17
von benpicco
dochdoch...
Tripod will dich nur ärgern ^^
einfach der Weiterleitung auf meine ewig nicht mehr aktualisierten homepage zustimmen und dann http://mitglied.lycos.de/benpicco/bps_DOS.rar in die Adressleiste kopierten (jaja, was nimmt man nicht alles in kauf für 50, mit Werbunbg verstopfte MB Webspace... Ich würd ja gern mal wechseln, aber das müsste ich alle über mein kleines Modem von einem Anbieter zum anderen laden...)

Verfasst: 24.08.2005 17:24
von shadow
jo, jetzt hab ich's, danke!

hmm, läuft aber net bei mir. der screen wird geöffnet und dann wird alles oben links im bildschirm ausgegeben (immer auf der selben zeile, wodurch die halt hellgrau wird). danach verabschiedet es sich mit einem komplettabsturz und dem windows-absturz-sich-meldungsdialog ...

ach so, der splash wird aber ausgegeben ;)

Verfasst: 24.08.2005 17:34
von benpicco
Oh, das muss wohl an einer defekten config.sys liegen...
Versuch´s jetzt nochmal, es müsste gehen...
Alle Zeiten sind UTC+02:00
Seite 1 von 2

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de